InteroceptionScale (study 2) - Data Analysis

Data Preparation

Code
library(tidyverse)
library(easystats)
library(patchwork)
library(ggside)
library(EGAnet)
library(tidygraph)
library(ggraph)

set.seed(42)

Sys.setenv(CHROMOTE_CHROME = "C:\\Program Files (x86)\\Microsoft\\Edge\\Application\\msedge.exe")
Code
df <- read.csv("../data/data_participants.csv") |> 
  rename(MINT_Urin_1 = MINT_Deficit_Urin_1,
         MINT_Urin_2 = MINT_Deficit_Urin_2,
         MINT_Urin_3 = MINT_Deficit_Urin_3,
         MINT_CaCo_1 = MINT_Deficit_CaCo_4,
         MINT_CaCo_2 = MINT_Deficit_CaCo_5,
         MINT_CaCo_3 = MINT_Deficit_CaCo_6,
         MINT_CaNo_1 = MINT_Deficit_CaNo_7,
         MINT_CaNo_2 = MINT_Deficit_CaNo_8,
         MINT_CaNo_3 = MINT_Deficit_CaNo_9,
         MINT_Olfa_1 = MINT_Deficit_Olfa_10,
         MINT_Olfa_2 = MINT_Deficit_Olfa_11,
         MINT_Olfa_3 = MINT_Deficit_Olfa_12,
         MINT_Sati_1 = MINT_Deficit_Sati_13,
         MINT_Sati_2 = MINT_Deficit_Sati_14,
         MINT_Sati_3 = MINT_Deficit_Sati_15,
         MINT_SexS_1 = MINT_Awareness_SexS_19,
         MINT_SexS_2 = MINT_Awareness_SexS_20,
         MINT_SexS_3 = MINT_Awareness_SexS_21,
         MINT_SexO_1 = MINT_Awareness_SexO_22,
         MINT_SexO_2 = MINT_Awareness_SexO_23,
         MINT_SexO_3 = MINT_Awareness_SexO_24,
         MINT_UrSe_1 = MINT_Awareness_UrSe_25,
         MINT_UrSe_2 = MINT_Awareness_UrSe_26,
         MINT_UrSe_3 = MINT_Awareness_UrSe_27,
         MINT_RelA_1 = MINT_Awareness_RelA_28,
         MINT_RelA_2 = MINT_Awareness_RelA_29,
         MINT_RelA_3 = MINT_Awareness_RelA_30,
         MINT_StaS_1 = MINT_Awareness_StaS_31,
         MINT_StaS_2 = MINT_Awareness_StaS_32,
         MINT_StaS_3 = MINT_Awareness_StaS_33,
         MINT_ExAc_1 = MINT_Awareness_ExAc_34,
         MINT_ExAc_2 = MINT_Awareness_ExAc_35,
         MINT_ExAc_3 = MINT_Awareness_ExAc_36,
         MINT_Card_1 = MINT_Sensitivity_Card_37,
         MINT_Card_2 = MINT_Sensitivity_Card_38,
         MINT_Card_3 = MINT_Sensitivity_Card_39,
         MINT_Resp_1 = MINT_Sensitivity_Resp_40,
         MINT_Resp_2 = MINT_Sensitivity_Resp_41,
         MINT_Resp_3 = MINT_Sensitivity_Resp_42,
         MINT_Gast_1 = MINT_Sensitivity_Gast_46,
         MINT_Gast_2 = MINT_Sensitivity_Gast_47,
         MINT_Gast_3 = MINT_Sensitivity_Gast_48,
         MINT_Derm_1 = MINT_Sensitivity_Derm_49,
         MINT_Derm_2 = MINT_Sensitivity_Derm_50,
         MINT_Derm_3 = MINT_Sensitivity_Derm_51)

colors <- c(Mint="#00BCD4", metaMint="#673AB7", miniMint="#26A36C", microMint="#8BC34A", 
            IAS="#F44336", MAIA="#FFAD04",  iMAIA="#FF7811", BPQ="#795548")

Structure Validation

items <- select(df, starts_with("MINT_"))
names(items) <- str_remove(names(items), "MINT_")
Code
labels <- list(
  MINT_Urin_1 = "I sometimes feel like I need to urinate or defecate but when I go to the bathroom I produce less than I expected",
  MINT_Urin_2 = "I often feel the need to urinate even when my bladder is not full",
  MINT_Urin_3 = "Sometimes I am not sure whether I need to go to the toilet or not (to urinate or defecate)",
  MINT_CaCo_1 = "Sometimes my breathing becomes erratic or shallow and I often don't know why",
  MINT_CaCo_2 = "I often feel like I can't get enough oxygen by breathing normally",
  MINT_CaCo_3 = "Sometimes my heart starts racing and I often don't know why",
  MINT_CaNo_1 = "I often only notice how I am breathing when it becomes loud",
  MINT_CaNo_2 = "I only notice my heart when it is thumping in my chest",
  MINT_CaNo_3 = "I often only notice how I am breathing when my breathing becomes shallow or irregular",
  MINT_Olfa_1 = "I often check the smell of my armpits",
  MINT_Olfa_2 = "I often check the smell of my own breath",
  MINT_Olfa_3 = "I often check the smell of my farts",
  MINT_Sati_1 = "I don't always feel the need to eat until I am really hungry",
  MINT_Sati_2 = "Sometimes I don't realise I was hungry until I ate something",
  MINT_Sati_3 = "I don't always feel the need to drink until I am really thirsty",
  # MINT_SexA_16 = "I always feel in my body if I am sexually aroused",
  # MINT_SexA_17 = "I can always tell that I am sexually aroused from the way I feel inside",
  # MINT_SexA_18 = "I always know when I am sexually aroused",
  MINT_SexS_1 = "During sex or masturbation, I often feel very strong sensations coming from my genital areas",
  MINT_SexS_2 = "When I am sexually aroused, I often notice specific sensations in my genital area (e.g., tingling, warmth, wetness, stiffness, pulsations)",
  MINT_SexS_3 = "My genital organs are very sensitive to pleasant stimulations",
  MINT_SexO_1 = "In general, I am very sensitive to changes in my genital organs",
  MINT_SexO_2 = "I can notice even very subtle changes in the state of my genital organs",
  MINT_SexO_3 = "I am always very aware of the state of my genital organs, even when I am calm",
  MINT_UrSe_1 = "In general, I am very aware of the sensations that are happening when I am urinating",
  MINT_UrSe_2 = "In general, I am very aware of the sensations that are happening when I am defecating",
  MINT_UrSe_3 = "I often experience a pleasant sensation when relieving myself when urinating or defecating)",
  MINT_RelA_1 = "I always know when I am relaxed",
  MINT_RelA_2 = "I always feel in my body if I am relaxed",
  MINT_RelA_3 = "My body is always in the same specific state when I am relaxed",
  MINT_StaS_1 = "Being relaxed is a very different bodily feeling compared to other states (e.g., feeling anxious, sexually aroused or after exercise)",
  MINT_StaS_2 = "Being sexually aroused is a very different bodily feeling compared to other states (e.g., feeling anxious, relaxed, or after physical exercise)",
  MINT_StaS_3 = "Being anxious is a very different bodily feeling compared to other states (e.g., feeling sexually aroused, relaxed or after exercise)",
  MINT_ExAc_1 = "I can always accurately feel when I am about to burp",
  MINT_ExAc_2 = "I can always accurately feel when I am about to fart",
  MINT_ExAc_3 = "I can always accurately feel when I am about to sneeze",
  MINT_Card_1 = "In general, I am very sensitive to changes in my heart rate",
  MINT_Card_2 = "I can notice even very subtle changes in the way my heart beats",
  MINT_Card_3 = "I often notice changes in my heart rate",
  MINT_Resp_1 = "I can notice even very subtle changes in my breathing",
  MINT_Resp_2 = "I am always very aware of how I am breathing, even when I am calm",
  MINT_Resp_3 = "In general, I am very sensitive to changes in my breathing",
  # MINT_Sign_43 = "When something important is happening in my life, I can feel immediately feel changes in my heart rate",
  # MINT_Sign_44 = "When something important is happening in my life, I can immediately feel changes in my breathing",
  # MINT_Sign_45 = "When something important is happening in my life, I can feel it in my body",
  MINT_Gast_1 = "I can notice even very subtle changes in what my stomach is doing",
  MINT_Gast_2 = "In general, I am very sensitive to what my stomach is doing",
  MINT_Gast_3 = "I am always very aware of what my stomach is doing, even when I am calm",
  MINT_Derm_1 = "In general, my skin is very sensitive",
  MINT_Derm_2 = "My skin is susceptible to itchy fabrics and materials",
  MINT_Derm_3 = "I can notice even very subtle stimulations to my skin (e.g., very light touches)"
  # MINT_SexC_52 = "When I am sexually aroused, I often feel changes in the way my heart beats (e.g., faster or stronger)",
  # MINT_SexC_53 = "When I am sexually aroused, I often feel changes in my breathing (e.g., faster, shallower, or less regular)",
  # MINT_SexC_54 = "When I am sexually aroused, I often feel changes in my temperature (e.g., feeling warm or cold)"
)


cleanlabels <- function(x, qname=FALSE) {
  is_factor <- FALSE
  if(is.factor(x)) {
    is_factor <- TRUE
    vec <- x
    x <- levels(x)
  }
  
  x <- x |> 
    str_replace("MINT_", ifelse(qname, "MINT - ", "")) |> 
    str_replace("MAIA_", ifelse(qname, "MAIA - ", "")) |> 
    str_replace("_", " - ") 
  
  if(is_factor) {
    levels(vec) <- x
    return(vec)
  }
  x
}

Full

EGA

Code
ega1 <- bootEGA(
  items,
  EGA.type = "hierEGA",
  model = "glasso",  # BGGM
  algorithm = "leiden",
  allow.singleton = TRUE,
  type="resampling",
  plot.itemStability=FALSE,
  typicalStructure=TRUE,
  plot.typicalGraph=FALSE,
  iter=500,
  seed=3, ncores = 4)

save(ega1, file="models/ega1.RData")
Code
load("models/ega1.RData")

itemstability <- EGAnet::itemStability(ega1, IS.plot=FALSE)
plot(itemstability)

Hierarchical Clustering

Code
hclust <- pvclust::pvclust(items,
                 method.hclust = "ward.D2",
                 method.dist = "correlation",
                 nboot = 1000, quiet=TRUE, parallel=TRUE)
plot(hclust, hang = -1, cex = 0.5)
pvclust::pvrect(hclust, alpha=0.95, max.only=TRUE)

Item Reduction

Code
rbind(rez, grandave) |> 
  select(-Group, -Rank) |> 
  pivot_wider(names_from = "Outcome", values_from = "R2") |> 
  mutate(Group = case_when(
    Dimension %in% c("Card", "Resp", "Gast", "CardRespGast", "CardResp", "CardGast") ~ "Visceral", 
    Dimension %in% c("RelA", "SexS", "ExaC", "StaS", "SexO", "UrSe") ~ "sensitivity", 
    Dimension %in% c("CaCo", "Urin", "Derm", "Olfa", "Sati", "CaNo") ~ "Deficit", 
    .default = "Other")) |> 
  select(Group, Dimension, Average, Interoception, Biofeedback, ER, 
         Primals, Alexithymia, Dissociative, Mood, 
         Physical, Mental, Lifestyle) |>
  arrange(Group, desc(Average)) |> 
  # select(-Group) |> 
  gt::gt() |> 
  gt::data_color(
    columns = -c(Dimension, Group),
    palette = c("white", "green"),
    domain = c(0, 1)
  ) |>
  gt::fmt_number() |>
  gt::tab_header(
    title = "Variable Importance",
    subtitle = "Normalized Predictive Power (R2)"
  ) |> 
  gt::tab_row_group(
    label = "Sensitivity",
    rows = Group == "sensitivity"
  )  |> 
  gt::tab_row_group(
    label = "Interoception",
    rows = Group == "Visceral"
  ) |> 
  gt::tab_row_group(
    label = "Deficit",
    rows = Group == "Deficit"
  ) |> 
  gt::cols_hide(Group)
Variable Importance
Normalized Predictive Power (R2)
Dimension Average Interoception Biofeedback ER Primals Alexithymia Dissociative Mood Physical Mental Lifestyle
Deficit
CaCo 0.62 0.10 0.05 0.32 0.77 1.00 1.00 1.00 0.64 0.72 0.76
Urin 0.43 0.09 0.20 0.07 0.54 0.64 0.52 0.61 0.74 0.45 0.22
Derm 0.32 0.06 0.01 0.15 0.35 0.29 0.20 0.34 0.87 0.59 0.08
Olfa 0.25 0.09 0.42 0.22 0.46 0.29 0.16 0.22 0.03 0.20 0.00
Sati 0.24 0.01 0.01 0.10 0.31 0.56 0.36 0.20 0.06 0.23 0.53
CaNo 0.05 0.01 0.01 0.05 0.00 0.10 0.01 0.06 0.02 0.03 0.20
Interoception
CardRespGast 0.32 0.78 0.81 0.26 0.11 0.04 0.08 0.19 0.28 0.22 0.01
CardResp 0.31 0.70 0.80 0.19 0.08 0.05 0.09 0.21 0.20 0.13 0.01
CardGast 0.28 0.62 0.73 0.19 0.10 0.03 0.07 0.19 0.36 0.23 0.01
Card 0.28 0.48 0.67 0.06 0.07 0.05 0.09 0.23 0.22 0.13 0.00
Resp 0.25 0.70 0.62 0.26 0.07 0.04 0.06 0.13 0.10 0.15 0.03
Gast 0.17 0.43 0.26 0.17 0.08 0.00 0.02 0.06 0.12 0.07 0.03
Sensitivity
RelA 0.54 0.77 0.49 0.92 0.79 0.57 0.47 0.29 0.21 0.22 0.51
SexS 0.23 0.28 0.54 0.07 0.22 0.15 0.15 0.03 0.02 0.08 0.41
UrSe 0.21 0.36 0.66 0.40 0.14 0.01 0.00 0.00 0.03 0.02 0.07
ExaC 0.20 0.16 0.12 0.11 0.33 0.10 0.09 0.03 0.04 0.17 0.08
SexO 0.18 0.43 0.48 0.23 0.03 0.00 0.00 0.01 0.00 0.02 0.19
StaS 0.16 0.21 0.13 0.04 0.10 0.16 0.28 0.02 0.02 0.08 0.18
Code
rbind(rez, grandave) |> 
  select(-Group, -R2) |> 
  pivot_wider(names_from = "Outcome", values_from = "Rank") |> 
  mutate(Group = case_when(
    Dimension %in% c("Card", "Resp", "Gast", "CardRespGast", "CardResp", "CardGast") ~ "Visceral", 
    Dimension %in% c("RelA", "SexS", "ExaC", "StaS", "SexO", "UrSe") ~ "sensitivity", 
    Dimension %in% c("CaCo", "Urin", "Derm", "Olfa", "Sati", "CaNo") ~ "Deficit", 
    .default = "Other")) |> 
  datawizard::data_relocate(select=c("Group", "Dimension", "Average", "Interoception")) |>
  arrange(Group, Average) |> 
  gt::gt() |> 
  # gt::fmt_number(columns = "Average") |>
  gt::data_color(
    columns = -c(Dimension, Group),
    palette = c("green", "white"),
    domain = c(1, 18)
  ) |> 
  gt::opt_interactive(page_size_default=20)
Code
hclust2 <- rez |>
  filter(Group != Outcome) |>
  select(-Group, -Rank) |>
  pivot_wider(names_from = "Dimension", values_from = "R2") |>
  select(-Outcome) |>
  pvclust::pvclust(
     method.hclust = "average",
     method.dist = "correlation",
     nboot = 1000, quiet=TRUE, parallel=TRUE)

plot(hclust2, hang = -1, cex = 0.5)
pvclust::pvrect(hclust2, alpha=0.95, max.only=TRUE)

Final

items <- items |> 
  select(
    -contains("UrSe"), # Unstable item
    -contains("StaS"), # Too vague and overlapping
    -contains("SexO"), # Overalapping with SexS
    
    -contains("CaNo") # Overlap with CaCo
    # -contains("Olfa"), # Unstable metacluster
    # -contains("Sati")
  )
Code
ega2 <- bootEGA(
  items,
  EGA.type = "hierEGA",
  model = "glasso",  # BGGM
  algorithm = "leiden",
  # consensus.method = "lowest_tefi",
  allow.singleton = TRUE,
  type="resampling",
  plot.itemStability=FALSE,
  typicalStructure=TRUE,
  plot.typicalGraph=FALSE,
  iter=500,
  seed=3, ncores = 4)

save(ega2, file="models/ega2.RData")
Code
load("models/ega2.RData")

# EGAnet::dimensionStability(ega)
itemstability <- EGAnet::itemStability(ega2, IS.plot=FALSE)
p_stab <- plot(itemstability)

Code
p_stab
Code
make_loadingtable <- function(x) {
  t <- as.data.frame(x) |>
    datawizard::data_addprefix("C")
  t$Cluster <- colnames(t)[max.col(t, ties.method='first')]

  t |>
    rownames_to_column(var="Item") |>
    rowwise() |>
    mutate(Max = max(c_across(-c(Item, Cluster)))) |>
    arrange(Cluster, desc(Max)) |>
    as.data.frame()
}

dimensions <- list(
  C01 = "SexS",       # Sexual Arousal Sensitivity
  C02 = "Derm",       # Dermal Hypersensitivity
  C03 = "Card",       # Cardioception
  C04 = "Sati",       # Satiety Awareness
  C05 = "Gast",       # Gastroception
  C06 = "Olfa",       # Olfactory Compensation
  C07 = "Resp",       # Respiroception
  C08 = "RelA",       # Relaxation Awareness
  C09 = "Urin",       # Urointestinal Inaccuracy
  C10 = "ExAc",       # Expulsion Accuracy
  C11 = "CaCo"       # Cardiorespiratory Confusion
  # C01 = "C01",
  # C02 = "C02",
  # C03 = "C03",
  # C04 = "C04",
  # C05 = "C05",
  # C06 = "C06",
  # C07 = "C07",
  # C08 = "C08",
  # C09 = "C09",
  # C10 = "C10",
  # C11 = "C11",
  # C12 = "C12"
)


higher <- make_loadingtable(t(net.loads(ega2$EGA$higher_order, loading.method="revised")$std)) |> 
  arrange(Item)
cluster_order <- names(higher)[!names(higher) %in% c("Item", "Cluster", "Max")]


lower <- make_loadingtable(net.loads(ega2$EGA$lower_order, loading.method="revised")$std) |>
  select(names(higher)) |>
  mutate(Cluster = fct_relevel(Cluster, cluster_order)) |>
  arrange(Cluster, desc(Max))
dimensions <- dimensions[names(dimensions) %in% names(lower)]

higher$Item <- paste0("M", higher$Item)
# higher$Label <- c("Interoceptive Deficit", "Interoceptive Awareness", "Interoceptive Sensitivity")
higher$Label <- c("Interoceptive Awareness", "Interoceptive Deficit", "Visceroception")
higher$ID  <- ""

lower <- mutate(lower, Label = labels[paste0("MINT_", Item)], ID=Item, Item = 1:n())

tab1 <- rbind(higher, lower) |>
  select(-ID) |>
  datawizard::data_relocate("Label", after = "Item") |>
  datawizard::data_rename(names(dimensions), dimensions[names(dimensions)]) |>
  select(-Cluster, -Max) |> 
  mutate(`|` = "") |> 
  gt::gt() |>
  gt::tab_row_group(
    label = "Items",
    rows = 1:(nrow(lower) + nrow(higher))
  ) |>
  gt::tab_row_group(
    label = "Metaclusters",
    rows = 1:nrow(higher)
  ) |>
  gt::data_color(columns=-Item,
                 method = "numeric",
                 palette = c("red", "white", "green"),
                 domain = c(-1, 1)) |>
  gt::tab_style(
    style = gt::cell_text(size="small", style="italic"),
    locations = gt::cells_body(columns="Label", rows=c(4:36))
  ) |>
  gt::tab_style(
    style = list(gt::cell_text(weight="bold"),
                 gt::cell_fill(color = "#F5F5F5")),
    locations = list(
      gt::cells_row_groups(groups = "Items"),
      gt::cells_row_groups(groups = "Metaclusters")
    )
  ) |>
  gt::fmt_number(columns=-Item, decimals=2) |>
  gt::tab_header(
    title = gt::md("**Item Loadings**"),
    subtitle = "Node centrality"
  ) |> 
  # Metacluster 1
  gt::tab_style(
    style = gt::cell_fill(color = "#81C784"),
    locations = list(
      gt::cells_body(columns="Item", rows=c(1))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#81C784"),
    locations = list(
      gt::cells_column_labels(columns = 3),
      gt::cells_body(columns="Item", rows=c(4:6))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#AED581"),
    locations = list(
      gt::cells_column_labels(columns = 4),
      gt::cells_body(columns="Item", rows=c(7:9))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#DCE775"),
    locations = list(
      gt::cells_column_labels(columns = 5),
      gt::cells_body(columns="Item", rows=c(10:12))
    )
  ) |> 
  gt::tab_style(
    style = gt::cell_fill(color = "#BA68C8"),
    locations = list(
      gt::cells_body(columns="Item", rows=c(2))
    )
  ) |> 
  gt::tab_style(
    style = gt::cell_fill(color = "#BA68C8"),
    locations = list(
      gt::cells_column_labels(columns = 6),
      gt::cells_body(columns="Item", rows=c(13:15))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#9575CD"),
    locations = list(
      gt::cells_column_labels(columns = 7),
      gt::cells_body(columns="Item", rows=c(16:18))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#7986CB"),
    locations = list(
      gt::cells_column_labels(columns = 8),
      gt::cells_body(columns="Item", rows=c(19:21))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#64B5F6"),
    locations = list(
      gt::cells_column_labels(columns = 9),
      gt::cells_body(columns="Item", rows=c(22:24))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#4DD0E1"),
    locations = list(
      gt::cells_column_labels(columns = 10),
      gt::cells_body(columns="Item", rows=c(25:27))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#FF7811"),
    locations = list(
      gt::cells_body(columns="Item", rows=c(3))
    )
  ) |> 
  gt::tab_style(
    style = gt::cell_fill(color = "#FFB74D"),
    locations = list(
      gt::cells_column_labels(columns = 11),
      gt::cells_body(columns="Item", rows=c(28:30))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#E57373"),
    locations = list(
      gt::cells_column_labels(columns = 12),
      gt::cells_body(columns="Item", rows=c(31:33))
    )
  ) |> 
  gt::tab_style(
    style = gt::cell_fill(color = "#A1887F"),
    locations = list(
      gt::cells_column_labels(columns = 13),
      gt::cells_body(columns="Item", rows=c(34:36))
    )
  ) 
tab1
Item Loadings
Node centrality
Item Label ExAc RelA SexS CaCo Urin Derm Sati Olfa Resp Card Gast |
Metaclusters
M1 Interoceptive Awareness 0.42 0.41 0.30 −0.20 −0.06 0.06 −0.07 0.08 0.13 0.02 0.12
M2 Interoceptive Deficit 0.00 −0.17 0.01 0.49 0.44 0.24 0.23 0.18 0.21 0.20 0.12
M3 Visceroception 0.02 0.15 0.02 0.20 0.01 0.11 0.00 0.13 0.60 0.58 0.33
Items
1 I can always accurately feel when I am about to fart 0.48 0.02 0.05 0.00 0.00 0.04 −0.01 0.10 0.00 0.00 0.00
2 I can always accurately feel when I am about to sneeze 0.48 0.09 0.01 0.00 0.00 0.04 0.00 0.00 0.00 0.00 0.00
3 I can always accurately feel when I am about to burp 0.46 0.06 0.01 −0.02 −0.04 0.05 −0.06 0.00 0.03 0.00 0.00
4 I always feel in my body if I am relaxed 0.02 0.59 0.02 −0.04 0.00 0.00 −0.01 0.00 0.04 0.00 0.03
5 I always know when I am relaxed 0.10 0.58 0.03 −0.10 −0.07 0.00 −0.03 −0.01 0.03 0.03 0.02
6 My body is always in the same specific state when I am relaxed 0.04 0.28 0.00 −0.01 0.00 0.00 0.00 0.00 0.00 0.03 0.00
7 During sex or masturbation, I often feel very strong sensations coming from my genital areas 0.01 0.03 0.65 −0.05 −0.04 0.00 0.00 0.00 0.00 0.00 0.00
8 My genital organs are very sensitive to pleasant stimulations 0.00 0.02 0.53 0.00 0.00 0.02 0.00 0.01 0.00 0.00 0.00
9 When I am sexually aroused, I often notice specific sensations in my genital area (e.g., tingling, warmth, wetness, stiffness, pulsations) 0.08 0.02 0.53 0.00 0.01 0.03 0.00 0.02 0.00 0.01 0.02
10 Sometimes my breathing becomes erratic or shallow and I often don't know why −0.02 −0.01 0.00 0.68 0.11 0.00 0.09 0.02 0.07 0.00 0.00
11 I often feel like I can't get enough oxygen by breathing normally 0.00 −0.07 −0.04 0.39 0.04 0.04 0.02 0.02 0.06 0.04 0.00
12 Sometimes my heart starts racing and I often don't know why 0.00 −0.07 0.00 0.37 0.06 0.05 0.03 0.00 0.00 0.16 0.00
13 I sometimes feel like I need to urinate or defecate but when I go to the bathroom I produce less than I expected 0.00 0.00 0.01 0.08 0.63 0.03 0.01 0.07 0.00 0.00 0.00
14 I often feel the need to urinate even when my bladder is not full 0.00 −0.01 0.00 0.04 0.44 0.09 0.00 0.02 0.00 0.00 0.01
15 Sometimes I am not sure whether I need to go to the toilet or not (to urinate or defecate) −0.04 −0.06 −0.03 0.09 0.32 0.00 0.12 0.00 0.00 0.00 0.00
16 In general, my skin is very sensitive 0.00 0.00 0.00 0.01 0.00 0.70 0.02 0.00 0.04 0.00 0.01
17 My skin is susceptible to itchy fabrics and materials 0.00 0.00 0.00 0.07 0.07 0.46 0.01 0.01 0.00 0.00 0.01
18 I can notice even very subtle stimulations to my skin (e.g., very light touches) 0.13 0.00 0.04 0.00 0.05 0.30 0.00 0.00 0.02 0.03 0.04
19 I don't always feel the need to eat until I am really hungry −0.01 0.00 0.00 0.00 0.00 0.01 0.60 0.00 0.00 0.00 0.00
20 Sometimes I don't realise I was hungry until I ate something −0.05 −0.02 0.00 0.09 0.10 0.01 0.49 0.02 0.01 0.00 0.00
21 I don't always feel the need to drink until I am really thirsty 0.00 −0.03 0.00 0.04 0.03 0.00 0.23 0.03 0.00 −0.01 0.00
22 I often check the smell of my armpits 0.00 −0.01 0.00 0.02 0.03 0.00 0.04 0.59 0.04 0.03 0.00
23 I often check the smell of my own breath 0.00 0.00 0.01 0.02 0.00 0.00 0.02 0.55 0.04 0.00 0.04
24 I often check the smell of my farts 0.10 0.00 0.01 0.00 0.06 0.01 0.00 0.28 0.00 0.00 0.01
25 In general, I am very sensitive to changes in my breathing 0.00 0.04 0.00 0.06 0.00 0.07 0.00 0.02 0.54 0.15 0.02
26 I can notice even very subtle changes in my breathing 0.03 0.03 0.00 0.03 0.00 0.00 0.00 0.01 0.54 0.14 0.02
27 I am always very aware of how I am breathing, even when I am calm 0.00 0.02 0.00 0.04 0.00 0.00 0.01 0.04 0.43 0.05 0.06
28 In general, I am very sensitive to changes in my heart rate 0.00 0.00 0.00 0.07 0.00 0.03 −0.01 0.00 0.11 0.55 0.03
29 I often notice changes in my heart rate 0.00 0.00 0.01 0.14 0.00 0.00 0.00 0.03 0.08 0.53 0.01
30 I can notice even very subtle changes in the way my heart beats 0.00 0.07 0.00 0.01 0.00 0.00 0.00 0.00 0.17 0.45 0.05
31 I can notice even very subtle changes in what my stomach is doing 0.00 0.02 0.00 0.00 0.01 0.04 0.00 0.03 0.05 0.04 0.59
32 In general, I am very sensitive to what my stomach is doing 0.00 0.00 0.01 0.00 0.00 0.02 0.00 0.02 0.00 0.02 0.58
33 I am always very aware of what my stomach is doing, even when I am calm 0.00 0.04 0.01 0.00 0.00 0.00 0.00 0.00 0.07 0.04 0.53
Code
gt::gtsave(tab1, "figures/table1.png", vwidth=1660, expand=0, quiet=TRUE)
Code
rez <- pvclust::pvclust(items,
                 method.hclust = "ward.D2",
                 method.dist = "correlation",
                 nboot = 1000, quiet=TRUE, parallel=TRUE)
plot(rez, hang = -1, cex = 0.5)
pvclust::pvrect(rez, alpha=0.95, max.only=FALSE)

Code
dendrogram <- as.dist(1 - cor(items, use = "pairwise.complete.obs")) |> 
  hclust(method = "ward.D2") |> 
  tidygraph::as_tbl_graph() 


# Process Nodes
nodes <- as.list(dendrogram)$nodes |> 
  mutate(Group = case_when(str_detect(label, "Card") ~ "Card", 
                           str_detect(label, "Resp") ~ "Resp",
                           str_detect(label, "Gast") ~ "Gast",
                           str_detect(label, "SexS") ~ "SexS",
                           str_detect(label, "RelA") ~ "RelA",
                           str_detect(label, "ExAc") ~ "ExAc",
                           str_detect(label, "Urin") ~ "Urin",
                           str_detect(label, "CaCo") ~ "CaCo",
                           str_detect(label, "Derm") ~ "Derm",
                           str_detect(label, "Olfa") ~ "Olfa",
                           str_detect(label, "Sati") ~ "Sati",
                           label == "" ~ "NA",
                           .default = "Other"),
         Size = setNames(lower$Max, lower$ID)[label],
         item = label)
nodes$idx <- 1:nrow(nodes)

# Rename accoring to table
items_newnames <- lower |>
  separate(ID, into = c("Group", "Item"), sep = "_", remove = FALSE) |>
  mutate(Name = paste0(Group, "-", 1:nrow(lower)))
items_newnames <- setNames(items_newnames$Name, items_newnames$ID)
  
nodes$label <- items_newnames[nodes$label]
nodes$label <- ifelse(is.na(nodes$label), "", nodes$label)

# Central node 
max_size  <- max(nodes$Size, na.rm = TRUE)
nodes[nodes$height == max(nodes$height), c("Group", "Size")] <- data.frame(Group="Central", Size=2 * max_size)
# Metaclusters
nodes[17, c("Group", "Size")] <- data.frame(Group="Awareness", Size=1.5 * max_size)
nodes[34, c("Group", "Size")] <- data.frame(Group="Visceroception", Size=1.5 * max_size)
nodes[63, c("Group", "Size")] <- data.frame(Group="Deficit", Size=1.5 * max_size)


# Process Edges
edges <- as.list(dendrogram)$edges
edges$linewidth = datawizard::rescale(nodes[edges$from, ]$height, to = c(0.1, 1))

p_hclust <- tbl_graph(nodes = nodes, edges = edges) |> 
  ggraph(layout = "dendrogram", circular = TRUE) +
  # geom_edge_diagonal(strength = 0.7, linewidth = 1) +
  geom_edge_elbow2(aes(edge_width=linewidth), color="darkgrey") +
  geom_node_point(aes(filter=Group %in% c("Central"), size = Size), color="darkgrey") +
  geom_node_point(aes(filter=Group %in% c("Visceroception", "Awareness", "Deficit"), color=Group, size = Size)) +
  geom_node_text(aes(
    label = ifelse(label != "NA", label, NA),
    x = x * 1.05,
    y = y * 1.05,
    filter = label != "",
    angle = ifelse(
      x >= 0,
      asin(y) * 360 / 2 / pi,
      360 - asin(y) * 360 / 2 / pi
    ),
    hjust = ifelse(
      x >= 0, 0, 1
    ))) +
  geom_node_point(aes(filter = label != "", color=Group, size=Size), alpha = 1) +
  # geom_node_text(aes(label=idx)) +  # Debug
  scale_edge_width_continuous(range=c(1, 3), guide = "none") +
  scale_size_continuous(range=c(3, 11), guide = "none") +
  scale_color_manual(values = c(
    "Visceroception" = "#FF7811", "Card" = "#F44336", "Resp"="#FF9800", "Gast"="#795548",
    "Awareness" = "#4CAF50", "ExAc"="#4CAF50", "RelA"="#8BC34A", "SexS" = "#CDDC39",
    "Deficit" = "#9C27B0", "CaCo"="#9C27B0", "Urin" = "#673AB7", "Derm"="#3F51B5",
    "Sati" = "#2196F3", "Olfa" = "#00BCD4"),
                     breaks = c(
                       "Awareness", "ExAc", "RelA", "SexS",
                       "Deficit", "CaCo", "Urin", "Derm", "Sati", "Olfa",
                       "Visceroception", "Resp", "Card", "Gast"
                       ),
                     labels=c(
                       "***Awareness***", "ExAc", "RelA", "SexS",
                       "***Deficit***", "CaCo", "Urin", "Derm", "Sati", "Olfa",
                       "***Visceroception***", "Resp", "Card", "Gast"
                       )) +
  ggtitle("Hierarchical Clustering", subtitle = "Method = Correlation") +
  coord_equal(clip = "off", xlim = c(-1.25, 1.25), ylim = c(-1.25, 1.25)) +
  theme_void() + 
  guides(color = guide_legend(override.aes = list(size = c(7.5, 5, 5, 3.5, 7.5, 5, 5, 3.5, 3.5, 3.5, 7.5, 5, 5, 3.5)))) +
  theme(legend.text = ggtext::element_markdown(),
        legend.title = element_blank(),
        plot.title = element_blank(),  #element_text(face="bold")
        plot.subtitle = element_blank())
p_hclust

Code
ggsave("figures/fig1a.png", p_stab, width=10, height=10*0.8, dpi=300)
ggsave("figures/fig1b.png", p_hclust, width=12, height=8, dpi=300)
Code
n <- parameters::n_factors(items)
plot(n)

Code
fa <- parameters::factor_analysis(items, n = 9, rotation = "varimax", sort = TRUE)
plot(fa)

Code
# fa |>
#   select(Variable, Uniqueness) |>
#   mutate(Group = str_extract(Variable, "^[A-Z][a-z]+")) |>
#   mutate(Average = mean(Uniqueness), .by = "Group") |> 
#   arrange(desc(Average), desc(Uniqueness)) |> 
#   select(-Average, -Group) |> 
#   gt::gt() |> 
#   gt::data_color(
#     columns = "Uniqueness",
#     palette = c("red", "white", "green"),
#     domain = c(0, 1) 
#   ) 

Score Extraction

Code
# Awareness
df$MINT_SexS <- rowMeans(select(df, starts_with("MINT_SexS_")), na.rm = TRUE)
df$MINT_ExaC <- rowMeans(select(df, starts_with("MINT_ExaC_")), na.rm = TRUE)
df$MINT_RelA <- rowMeans(select(df, starts_with("MINT_RelA_")), na.rm = TRUE)
# df$MINT_StaS <- rowMeans(select(df, starts_with("MINT_StaS_")), na.rm = TRUE)
# df$MINT_SexO <- rowMeans(select(df, starts_with("MINT_SexO_")), na.rm = TRUE)
# df$MINT_UrSe <- rowMeans(select(df, starts_with("MINT_UrSe_")), na.rm = TRUE)

# Deficit
df$MINT_Urin <- rowMeans(select(df, starts_with("MINT_Urin_")), na.rm = TRUE)
df$MINT_CaCo <- rowMeans(select(df, starts_with("MINT_CaCo_")), na.rm = TRUE)
df$MINT_Derm <- rowMeans(select(df, starts_with("MINT_Derm_")), na.rm = TRUE)
# df$MINT_CaNo <- rowMeans(select(df, starts_with("MINT_CaNo_")), na.rm = TRUE)

df$MINT_Sati <- rowMeans(select(df, starts_with("MINT_Sati_")), na.rm = TRUE)
df$MINT_Olfa <- rowMeans(select(df, starts_with("MINT_Olfa_")), na.rm = TRUE)

# Visceral
df$MINT_Resp <- rowMeans(select(df, starts_with("MINT_Resp_")), na.rm = TRUE)
df$MINT_Card <- rowMeans(select(df, starts_with("MINT_Card_")), na.rm = TRUE)
df$MINT_Gast <- rowMeans(select(df, starts_with("MINT_Gast_")), na.rm = TRUE)

df <- df[names(df)[!grepl("MINT_.*[0-9]$", names(df))]]

Mini Versions

Code
mint <- select(df, starts_with("MINT_"))

metamint <- data.frame(
  MINT_Awareness = rowMeans(select(df, MINT_SexS, MINT_ExaC, MINT_RelA)),
  MINT_Deficit = rowMeans(select(df, MINT_CaCo, MINT_Urin, MINT_Derm, MINT_Sati, MINT_Olfa)),
  MINT_Visceroception = rowMeans(select(df, MINT_Card, MINT_Resp, MINT_Gast))
)

minimint <- data.frame(
  MINT_Awareness = rowMeans(select(df, MINT_ExaC, MINT_RelA)),
  MINT_Deficit = rowMeans(select(df, MINT_CaCo, MINT_Urin)),
  MINT_Visceroception = rowMeans(select(df, MINT_Resp, MINT_Card))
)

micromint <- data.frame(
  MINT_ExaC = df$MINT_ExaC,
  MINT_CaCo = df$MINT_CaCo,
  MINT_Resp = df$MINT_Resp
)
Code
make_cor <- function(df1, df2=NULL, qname_x=TRUE, qname_y=TRUE, textsize = 2.9, xcol = "#424242", ycol="#424242") {
  
  r <- df1 |> 
    correlation::correlation(data2=df2, p_adjust="none", redundant=ifelse(is.null(df2), TRUE, FALSE)) |> 
    correlation::cor_sort() |>
    mutate(label = ifelse(p < .001, paste0(insight::format_value(r)), ""),
           Parameter1 = cleanlabels(Parameter1, qname=qname_x),
           Parameter2 = cleanlabels(Parameter2, qname=qname_y))
  r[as.character(r$Parameter1) == as.character(r$Parameter2), "label"] <- ""
  
  xnames <- levels(r$Parameter1)
  ynames <- levels(r$Parameter2)
  
  xcol <- case_when(
    str_detect(xnames, "MINT") ~ "#00838F",
    str_detect(xnames, "MAIA") ~ "#EF6C00",
    str_detect(xnames, "IAS") ~ "#C62828",
    str_detect(xnames, "BPQ") ~ "#795548",
    .default = xcol
  )
  ycol <- case_when(
    str_detect(ynames, "MINT") ~ "#00838F",
    str_detect(ynames, "MAIA") ~ "#EF6C00",
    str_detect(ynames, "IAS") ~ "#C62828",
    str_detect(ynames, "BPQ") ~ "#795548",
    .default = ycol
  )
  xbold <- case_when(
    xnames %in% c("Awareness", "MINT - Awareness") ~ "bold",
    str_detect(xnames, "Visceroception") ~ "bold",
    str_detect(xnames, "Deficit") ~ "bold",
    .default = "plain"
  )
  ybold <- case_when(
    ynames %in% c("Awareness", "MINT - Awareness") ~ "bold",
    str_detect(ynames, "Visceroception") ~ "bold",
    str_detect(ynames, "Deficit") ~ "bold",
    .default = "plain"
  )
  
  r |> 
    ggplot(aes(x=Parameter1, y=Parameter2, fill=r)) +
    geom_tile() +
    geom_text(aes(label=label), size=textsize) +
    scale_fill_gradient2(low="blue", high="red", mid="white", midpoint=0) +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust=1, color = xcol, face = xbold),
          axis.text.y = element_text(color = ycol, face = ybold),
          legend.position = "none",
          axis.title = element_blank())
}


p_cormint <- make_cor(cbind(mint, metamint), qname_x = FALSE, qname_y = FALSE, textsize = 2.5,
                      xcol = "#00838F", ycol = "#00838F") +
  labs(title="Correlations between MINT dimensions") +
  theme(axis.title = element_blank())

p_cormint

Convegent Validity

Code
p_corintero <- make_cor(select(df, starts_with("MAIA"), IAS, BPQ),
                        cbind(mint, metamint), qname_y = FALSE, textsize = 2.5,
                        ycol = "#00838F") +
  labs(title="MINT vs. Other Interoception Questionnaires") +
  theme(axis.title = element_blank())
p_corintero

Most correlated dimensions: - IAS: ExAc - Trusting: RelA - Noticing: Resp - Emotional Awareness: Resp - Body Listening: Gast - SelfRegulation: RelA - AttentionRegulation: RelA - BPQ: Card

Code
table_models <- function(models) {
  test <- test_performance(models)
  table <- compare_performance(models, metrics=c("R2", "BIC"))
  test$Model <- NULL
  test$Omega2 <- NULL
  test$p_Omega2 <- NULL
  test$R2 <- table$R2
  test$BIC <- table$BIC
  
  preds <- c()
  coefs <- c()
  for(m in models){
    x <- names(sort(abs(coef(m)[-1]), decreasing=TRUE))
    preds <- c(preds, paste0(cleanlabels(x), collapse = ", "))
    if(length(coef(m)) == 2) {
      coefs <- c(coefs, coef(m)[2])
    }
  }
  
  if(length(coefs) == length(models)) test$Coefficient <- coefs
  format(test, zap_small = TRUE)
}

# Individual predictors ------------------------------------------------------

compare_predictors <- function(outcome="TAS_DIF", family = "linear") {
  
  preds <- c("BPQ", "IAS", 
             names(select(df, starts_with("MINT"), -matches("[[:digit:]]"))),
             names(select(df, starts_with("MAIA"))),
             names(metamint))
  
  models <- list()
  for(p in preds) {
    if(length(unique(df[[outcome]])) > 2) {
      if (family == "linear") {
        models[[p]] <- lm(as.formula(paste0(outcome, " ~ ", p)), data=cbind(df, metamint))
      } else {
        models[[p]] <- glm(as.formula(paste0(outcome, " ~ ", p)), data=cbind(df, metamint), family=family)
      }
    } else {
      models[[p]] <- glm(as.formula(paste0(outcome, " ~ ", p)), data=standardize(cbind(df, metamint), exclude=outcome), family="binomial")
    }
  }
  perf <- compare_performance(models) |> 
    arrange(AIC)
  
  best_mint <- perf$Name[str_detect(perf$Name, "MINT_")][1]
  best_maia <- perf$Name[str_detect(perf$Name, "MAIA")][1]
  
  table <- table_models(models[c(best_mint, best_maia, "BPQ", "IAS")])
  
  # Make plots --------------------------------------------------
  df_pred <- data.frame()
  for(p in c(best_mint, best_maia, "BPQ", "IAS")) {
    pred <- modelbased::estimate_relation(models[[p]], by=p, length=30) 
    names(pred)[1] <- "Value"
    pred$Predictor <- p
    df_pred <- rbind(df_pred, pred)
  }
  
  cols <- colors
  cols[[best_mint]] <- cols["Mint"]
  cols[[best_maia]] <- cols["MAIA"]
  
  p <- df_pred |>
    mutate(Predictor = fct_rev(Predictor)) |> 
    ggplot(aes(x=Value, y=Predicted)) +
    geom_ribbon(aes(ymin=CI_low, ymax=CI_high, fill=Predictor), alpha=0.3) +
    geom_line(aes(color=Predictor)) +
    scale_fill_manual(values=cols) +
    scale_color_manual(values=cols) +
    facet_wrap(~Predictor, scales="free_x") +
    labs(y=outcome, x="Interoception Index")
  
  list(table=table, p=p, outcome=outcome)
}




# Full Models ------------------------------------------------------

compare_models_lm <- function(outcome="TAS_DIF") {
  
  # Full Questionnaires
  m_mint <- lm(as.formula(paste0(outcome, " ~ .")),
              data = cbind(mint, df[outcome]))
  m_metamint <- lm(as.formula(paste0(outcome, " ~ .")),
              data = cbind(metamint, df[outcome])) 
  m_minimint <- lm(as.formula(paste0(outcome, " ~ .")),
              data = cbind(minimint, df[outcome])) 
  m_micromint <- lm(as.formula(paste0(outcome, " ~ .")),
              data = cbind(micromint, df[outcome])) 
  m_ias <- lm(as.formula(paste0(outcome, " ~ IAS")),
              data = df)
  m_maia <- lm(as.formula(paste0(outcome, " ~ .")),
                data = select(df, all_of(outcome), starts_with("MAIA"))) 
  m_imaia <- lm(as.formula(paste0(outcome, " ~ .")),
                data = select(df, all_of(outcome), 
                              starts_with("MAIA"), 
                              -contains("NotWorrying"),
                              -contains("NotDistracting"))) 
  m_imaia <- lm(as.formula(paste0(outcome, " ~ .")),
                data = select(df, all_of(outcome),
                              # MAIA_AttentionRegulation, # remove?
                              # MAIA_SelfRegulation, # remove?
                              # MAIA_Trusting, # remove?
                              MAIA_BodyListening, 
                              MAIA_EmotionalAwareness,
                              MAIA_Noticing))
  m_bpq <- lm(as.formula(paste0(outcome, " ~ BPQ")),
                data = df)
  
  models_full <- list(m_mint=m_mint, m_metamint=m_metamint,
                      m_minimint=m_minimint, m_micromint=m_micromint, 
                      m_maia=m_maia, m_imaia=m_imaia, 
                      m_ias=m_ias, m_bpq=m_bpq)
  table_models(models_full)
}
Code
preds_dif <- compare_predictors("TAS_DIF")
display(preds_dif$table, title="DIF")
DIF
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.22 1108.37 0.31
MAIA_Trusting < 0.001 1.33 0.091 0.17 1150.81 -0.18
BPQ < 0.001 7.14 < .001 0.01 1286.24 0.05
IAS < 0.001 3.81 < .001 0.08 1226.64 -0.02

Each model is compared to MINT_Deficit.

Code
preds_dif$p

Code
mods_dif <- compare_models_lm("TAS_DIF")
display(mods_dif, title="DIF")
DIF
Name BF LR p (LR) R2 BIC
m_mint 0.31 1081.51
m_metamint > 1000 2.53 0.006 0.29 1052.69
m_minimint < 0.001 4.25 < .001 0.24 1104.97
m_micromint < 0.001 5.41 < .001 0.19 1150.47
m_maia < 0.001 2.74 0.003 0.23 1148.37
m_imaia < 0.001 8.47 < .001 0.02 1292.91
m_ias < 0.001 6.77 < .001 0.08 1226.64
m_bpq < 0.001 8.89 < .001 0.01 1286.24

Each model is compared to m_mint.

Code
preds_ddf <- compare_predictors("TAS_DDF")
display(preds_ddf$table, title="DDF")
DDF
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.18 1489.14 0.35
MAIA_Trusting 0.003 0.37 0.356 0.17 1500.71 -0.22
BPQ < 0.001 5.99 < .001 0.01 1629.83 0.07
IAS < 0.001 2.79 0.003 0.08 1571.78 -0.02

Each model is compared to MINT_Deficit.

Code
preds_ddf$p

Code
mods_ddf <- compare_models_lm("TAS_DDF")
display(mods_ddf, title="DDF")
DDF
Name BF LR p (LR) R2 BIC
m_mint 0.25 1485.21
m_metamint > 1000 1.51 0.065 0.24 1441.45
m_minimint 0.045 3.75 < .001 0.19 1491.40
m_micromint < 0.001 4.78 < .001 0.15 1528.48
m_maia < 0.001 1.31 0.095 0.22 1502.42
m_imaia < 0.001 7.45 < .001 0.01 1640.19
m_ias < 0.001 5.26 < .001 0.08 1571.78
m_bpq < 0.001 7.69 < .001 0.01 1629.83

Each model is compared to m_mint.

Code
preds_eot <- compare_predictors("TAS_EOT")
display(preds_eot$table, title="EOT")
EOT
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.20 931.21 0.25
MAIA_Trusting < 0.001 3.81 < .001 0.07 1034.62 -0.10
BPQ < 0.001 6.29 < .001 0.01 1080.86 0.07
IAS < 0.001 4.78 < .001 0.04 1061.30 -0.01

Each model is compared to MINT_Deficit.

Code
preds_eot$p

Code
mods_eot <- compare_models_lm("TAS_EOT")
display(mods_eot, title="EOT")
EOT
Name BF LR p (LR) R2 BIC
m_mint 0.24 959.67
m_metamint > 1000 1.25 0.106 0.23 913.25
m_minimint 0.017 3.93 < .001 0.17 967.79
m_micromint < 0.001 5.28 < .001 0.12 1011.59
m_maia < 0.001 2.69 0.004 0.15 1017.28
m_imaia < 0.001 6.57 < .001 0.01 1096.63
m_ias < 0.001 6.33 < .001 0.04 1061.30
m_bpq < 0.001 6.99 < .001 0.01 1080.86

Each model is compared to m_mint.

Code
make_cor(select(df, starts_with("TAS_")),
         cbind(mint, metamint, select(df, starts_with("MAIA"), IAS, BPQ)))
Warning: Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.
Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.

Code
preds_ls <- compare_predictors("LifeSatisfaction")
display(preds_ls$table, title="Life Satisfaction")
Life Satisfaction
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.05 3104.38 -0.51
MAIA_Trusting > 1000 -6.57 < .001 0.28 2896.13 0.80
BPQ < 0.001 3.09 0.001 0.00 3141.29 -0.06
IAS 0.970 0.00 0.499 0.05 3104.44 0.04

Each model is compared to MINT_Deficit.

Code
preds_ls$p

Code
mods_ls <- compare_models_lm("LifeSatisfaction")
display(mods_ls, title="Life Satisfaction")
Life Satisfaction
Name BF LR p (LR) R2 BIC
m_mint 0.11 3123.86
m_metamint > 1000 1.89 0.030 0.09 3086.66
m_minimint > 1000 1.82 0.035 0.09 3086.07
m_micromint > 1000 2.88 0.002 0.06 3108.06
m_maia > 1000 -6.34 < .001 0.30 2922.14
m_imaia 0.149 3.11 < .001 0.04 3127.66
m_ias > 1000 2.54 0.006 0.05 3104.44
m_bpq < 0.001 4.51 < .001 0.00 3141.29

Each model is compared to m_mint.

Code
preds_anx <- compare_predictors("PHQ4_Anxiety")
display(preds_anx$table, title="PHQ4 Anxiety")
PHQ4 Anxiety
Name BF LR p (LR) R2 BIC Coefficient
MINT_CaCo 0.20 2776.91 0.52
MAIA_Trusting 75.10 -0.29 0.385 0.21 2768.28 -0.60
BPQ < 0.001 5.58 < .001 0.03 2918.47 0.33
IAS < 0.001 5.81 < .001 0.02 2922.86 -0.03

Each model is compared to MINT_CaCo.

Code
preds_anx$p

Code
mods_anx <- compare_models_lm("PHQ4_Anxiety")
display(mods_anx, title="PHQ4 Anxiety")
PHQ4 Anxiety
Name BF LR p (LR) R2 BIC
m_mint 0.27 2771.46
m_metamint > 1000 2.89 0.002 0.24 2750.78
m_minimint 44.43 3.42 < .001 0.23 2763.87
m_micromint 0.002 4.32 < .001 0.20 2784.46
m_maia > 1000 -2.74 0.003 0.36 2662.72
m_imaia < 0.001 8.10 < .001 0.00 2950.21
m_ias < 0.001 7.89 < .001 0.02 2922.86
m_bpq < 0.001 7.63 < .001 0.03 2918.47

Each model is compared to m_mint.

Code
preds_dep <- compare_predictors("PHQ4_Depression")
display(preds_dep$table, title="PHQ4 Depression")
PHQ4 Depression
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.14 2631.44 0.65
MAIA_Trusting > 1000 -2.66 0.004 0.24 2544.32 -0.55
BPQ < 0.001 5.09 < .001 0.02 2728.02 0.24
IAS < 0.001 4.15 < .001 0.03 2721.19 -0.02

Each model is compared to MINT_Deficit.

Code
preds_dep$p

Code
mods_dep <- compare_models_lm("PHQ4_Depression")
display(mods_dep, title="PHQ4 Depression")
PHQ4 Depression
Name BF LR p (LR) R2 BIC
m_mint 0.19 2649.42
m_metamint > 1000 2.41 0.008 0.17 2618.44
m_minimint > 1000 2.81 0.002 0.15 2631.95
m_micromint 1.31 3.73 < .001 0.14 2648.89
m_maia > 1000 -3.43 < .001 0.30 2523.07
m_imaia < 0.001 6.78 < .001 0.01 2750.60
m_ias < 0.001 6.12 < .001 0.03 2721.19
m_bpq < 0.001 6.17 < .001 0.02 2728.02

Each model is compared to m_mint.

Code
make_cor(select(df, LifeSatisfaction, starts_with("PHQ4_")),
         cbind(mint, metamint, select(df, starts_with("MAIA"), IAS, BPQ)))
Warning: Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.
Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.

  • CaCo and RelA
Code
preds_arou <- compare_predictors("ERS_Arousal")
display(preds_arou$table, title="ERS Arousal")
ERS Arousal
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.20 2158.88 0.58
MAIA_NotWorrying 0.018 0.24 0.403 0.19 2166.87 -0.43
BPQ < 0.001 5.40 < .001 0.04 2293.10 0.24
IAS < 0.001 6.18 < .001 0.00 2317.10 -0.01

Each model is compared to MINT_Deficit.

Code
preds_arou$p

Code
mods_arou <- compare_models_lm("ERS_Arousal")
display(mods_arou, title="ERS Arousal")
ERS Arousal
Name BF LR p (LR) R2 BIC
m_mint 0.23 2193.71
m_metamint > 1000 2.26 0.012 0.21 2162.32
m_minimint 0.742 3.66 < .001 0.17 2194.31
m_micromint < 0.001 4.49 < .001 0.14 2220.35
m_maia > 1000 -2.72 0.003 0.32 2084.82
m_imaia < 0.001 5.65 < .001 0.04 2302.61
m_ias < 0.001 7.08 < .001 0.00 2317.10
m_bpq < 0.001 6.41 < .001 0.04 2293.10

Each model is compared to m_mint.

Code
preds_sens <- compare_predictors("ERS_Sensitivity")
display(preds_sens$table, title="ERS Sensitivity")
ERS Sensitivity
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.18 2322.13 0.60
MAIA_NotWorrying > 1000 -1.16 0.122 0.22 2284.12 -0.52
BPQ < 0.001 5.32 < .001 0.03 2442.94 0.24
IAS < 0.001 6.03 < .001 0.00 2462.74 -0.01

Each model is compared to MINT_Deficit.

Code
preds_sens$p

Code
mods_sens <- compare_models_lm("ERS_Sensitivity")
display(mods_sens, title="ERS Sensitivity")
ERS Sensitivity
Name BF LR p (LR) R2 BIC
m_mint 0.21 2354.48
m_metamint > 1000 2.58 0.005 0.18 2327.69
m_minimint > 1000 2.96 0.002 0.17 2336.80
m_micromint 0.010 4.12 < .001 0.14 2363.76
m_maia > 1000 -3.02 0.001 0.30 2242.73
m_imaia < 0.001 6.02 < .001 0.02 2461.56
m_ias < 0.001 6.85 < .001 0.00 2462.74
m_bpq < 0.001 6.21 < .001 0.03 2442.94

Each model is compared to m_mint.

Code
preds_pers <- compare_predictors("ERS_Persistence")
display(preds_pers$table, title="ERS Persistence")
ERS Persistence
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.18 2230.34 0.58
MAIA_NotWorrying > 1000 -0.49 0.314 0.20 2214.67 -0.46
BPQ < 0.001 5.50 < .001 0.02 2360.53 0.20
IAS < 0.001 5.16 < .001 0.02 2360.32 -0.02

Each model is compared to MINT_Deficit.

Code
preds_pers$p

Code
mods_pers <- compare_models_lm("ERS_Persistence")
display(mods_pers, title="ERS Persistence")
ERS Persistence
Name BF LR p (LR) R2 BIC
m_mint 0.21 2268.66
m_metamint > 1000 2.10 0.018 0.19 2233.85
m_minimint 392.09 3.11 < .001 0.17 2256.71
m_micromint 0.115 3.72 < .001 0.15 2272.99
m_maia > 1000 -2.71 0.003 0.30 2162.52
m_imaia < 0.001 5.70 < .001 0.02 2374.26
m_ias < 0.001 6.18 < .001 0.02 2360.32
m_bpq < 0.001 6.20 < .001 0.02 2360.53

Each model is compared to m_mint.

Code
make_cor(select(df, starts_with("ERS_")),
         cbind(mint, metamint, select(df, starts_with("MAIA"), IAS, BPQ)))
Warning: Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.
Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.

  • CaCo

Exploratory

Code
make_cor(select(df, starts_with("MINT"), -matches("[[:digit:]]")), 
         select(df, starts_with("CEFSA")))
Warning: Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.
Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.

Code
make_cor(select(df, starts_with("MAIA"), IAS, BPQ), 
         select(df, starts_with("CEFSA")))
Warning: Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.
Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.

Code
preds_cefsabody <- compare_predictors("CEFSA_Body")
display(preds_cefsabody$table, title="CEFSA - Body")
CEFSA - Body
Name BF LR p (LR) R2 BIC Coefficient
MINT_CaCo 0.23 1796.97 0.29
MAIA_Trusting < 0.001 1.33 0.092 0.18 1842.88 -0.29
BPQ < 0.001 5.60 < .001 0.03 1963.32 0.18
IAS < 0.001 4.41 < .001 0.06 1941.95 -0.02

Each model is compared to MINT_CaCo.

Code
preds_cefsabody$p

Code
mods_cefsabody <- compare_models_lm("CEFSA_Body")
display(mods_cefsabody, title="CEFSA - Body")
CEFSA - Body
Name BF LR p (LR) R2 BIC
m_mint 0.31 1775.41
m_metamint > 1000 2.24 0.013 0.29 1746.37
m_minimint 4.55 3.36 < .001 0.27 1772.38
m_micromint < 0.001 4.20 < .001 0.24 1799.86
m_maia < 0.001 3.04 0.001 0.22 1849.23
m_imaia < 0.001 8.40 < .001 0.00 1999.73
m_ias < 0.001 7.18 < .001 0.06 1941.95
m_bpq < 0.001 7.81 < .001 0.03 1963.32

Each model is compared to m_mint.

Code
preds_cefsaself <- compare_predictors("CEFSA_Self")
display(preds_cefsaself$table, title="CEFSA - Self")
CEFSA - Self
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.21 2032.82 0.56
MAIA_Trusting < 0.001 2.75 0.003 0.12 2110.11 -0.28
BPQ < 0.001 6.87 < .001 0.02 2191.47 0.17
IAS < 0.001 3.87 < .001 0.07 2149.73 -0.03

Each model is compared to MINT_Deficit.

Code
preds_cefsaself$p

Code
mods_cefsaself <- compare_models_lm("CEFSA_Self")
display(mods_cefsaself, title="CEFSA - Self")
CEFSA - Self
Name BF LR p (LR) R2 BIC
m_mint 0.28 2034.87
m_metamint > 1000 2.15 0.016 0.26 2003.23
m_minimint 6.92 3.46 < .001 0.23 2031.00
m_micromint < 0.001 4.65 < .001 0.19 2069.05
m_maia < 0.001 3.21 < .001 0.18 2106.09
m_imaia < 0.001 8.22 < .001 0.00 2218.46
m_ias < 0.001 6.08 < .001 0.07 2149.73
m_bpq < 0.001 7.76 < .001 0.02 2191.47

Each model is compared to m_mint.

Code
preds_cefsaemo <- compare_predictors("CEFSA_Emotion")
display(preds_cefsaemo$table, title="CEFSA - Emotion")
CEFSA - Emotion
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.14 2143.82 0.47
MAIA_Trusting > 1000 -0.88 0.189 0.17 2118.54 -0.34
BPQ < 0.001 5.23 < .001 0.01 2250.82 0.09
IAS 0.010 0.32 0.376 0.13 2153.04 -0.04

Each model is compared to MINT_Deficit.

Code
preds_cefsaemo$p

Code
mods_cefsaemo <- compare_models_lm("CEFSA_Emotion")
display(mods_cefsaemo, title="CEFSA - Emotion")
CEFSA - Emotion
Name BF LR p (LR) R2 BIC
m_mint 0.27 2089.99
m_metamint > 1000 2.17 0.015 0.25 2060.65
m_minimint < 0.001 4.33 < .001 0.19 2112.18
m_micromint < 0.001 5.21 < .001 0.15 2150.24
m_maia < 0.001 2.39 0.008 0.19 2144.24
m_imaia < 0.001 6.29 < .001 0.05 2228.72
m_ias < 0.001 4.38 < .001 0.13 2153.04
m_bpq < 0.001 7.78 < .001 0.01 2250.82

Each model is compared to m_mint.

Code
preds_cefsareal <- compare_predictors("CEFSA_Reality")
display(preds_cefsareal$table, title="CEFSA - Reality")
CEFSA - Reality
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.18 1899.23 0.46
MAIA_Trusting < 0.001 1.14 0.127 0.14 1930.10 -0.27
BPQ < 0.001 6.63 < .001 0.01 2034.63 0.13
IAS < 0.001 3.97 < .001 0.06 1999.65 -0.02

Each model is compared to MINT_Deficit.

Code
preds_cefsareal$p

Code
mods_cefsareal <- compare_models_lm("CEFSA_Reality")
display(mods_cefsareal, title="CEFSA - Reality")
CEFSA - Reality
Name BF LR p (LR) R2 BIC
m_mint 0.24 1906.86
m_metamint > 1000 1.69 0.046 0.23 1866.90
m_minimint 189.67 3.06 0.001 0.20 1896.37
m_micromint < 0.001 4.24 < .001 0.16 1931.22
m_maia < 0.001 2.30 0.011 0.18 1946.66
m_imaia < 0.001 7.36 < .001 0.01 2053.67
m_ias < 0.001 5.98 < .001 0.06 1999.65
m_bpq < 0.001 7.22 < .001 0.01 2034.63

Each model is compared to m_mint.

Code
preds_cefsacon <- compare_predictors("CEFSA_Connection")
display(preds_cefsacon$table, title="CEFSA - Connection")
CEFSA - Connection
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.17 2273.53 0.58
MAIA_Trusting > 1000 -2.08 0.019 0.25 2201.91 -0.46
BPQ < 0.001 5.89 < .001 0.01 2402.97 0.16
IAS < 0.001 2.58 0.005 0.09 2346.87 -0.03

Each model is compared to MINT_Deficit.

Code
preds_cefsacon$p

Code
mods_cefsacon <- compare_models_lm("CEFSA_Connection")
display(mods_cefsacon, title="CEFSA - Connection")
CEFSA - Connection
Name BF LR p (LR) R2 BIC
m_mint 0.25 2263.13
m_metamint > 1000 2.38 0.009 0.23 2235.43
m_minimint 21.99 3.43 < .001 0.21 2256.94
m_micromint < 0.001 4.52 < .001 0.17 2292.99
m_maia > 1000 -0.73 0.233 0.28 2220.93
m_imaia < 0.001 7.32 < .001 0.02 2409.99
m_ias < 0.001 5.31 < .001 0.09 2346.87
m_bpq < 0.001 7.55 < .001 0.01 2402.97

Each model is compared to m_mint.

Code
preds_cefsagency <- compare_predictors("CEFSA_Agency")
display(preds_cefsagency$table, title="CEFSA - Agency")
CEFSA - Agency
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.18 2122.91 0.54
MAIA_Trusting < 0.001 1.07 0.142 0.15 2153.22 -0.32
BPQ < 0.001 6.30 < .001 0.02 2260.65 0.15
IAS < 0.001 3.97 < .001 0.06 2227.64 -0.03

Each model is compared to MINT_Deficit.

Code
preds_cefsagency$p

Code
mods_cefsagency <- compare_models_lm("CEFSA_Agency")
display(mods_cefsagency, title="CEFSA - Agency")
CEFSA - Agency
Name BF LR p (LR) R2 BIC
m_mint 0.25 2124.18
m_metamint > 1000 2.21 0.014 0.23 2092.38
m_minimint < 0.001 4.14 < .001 0.18 2141.94
m_micromint < 0.001 4.80 < .001 0.15 2163.94
m_maia < 0.001 2.14 0.016 0.19 2164.45
m_imaia < 0.001 7.77 < .001 0.01 2279.55
m_ias < 0.001 6.23 < .001 0.06 2227.64
m_bpq < 0.001 7.44 < .001 0.02 2260.65

Each model is compared to m_mint.

Code
make_cor(select(df, starts_with("MINT"), -matches("[[:digit:]]")), 
         select(df, starts_with("CERQ")))
Warning: Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.
Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.

Code
make_cor(select(df, starts_with("MAIA"), IAS, BPQ), 
         select(df, starts_with("CERQ")))
Warning: Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.
Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.

Code
preds_cerqreapp <- compare_predictors("CERQ_PositiveReappraisal")
display(preds_cerqreapp$table, title="CERQ - Positive Reappraisal")
CERQ - Positive Reappraisal
Name BF LR p (LR) R2 BIC Coefficient
MINT_Awareness 0.07 1985.50 0.31
MAIA_Trusting > 1000 -3.13 < .001 0.15 1912.14 0.28
BPQ < 0.001 2.12 0.017 0.02 2020.91 0.15
IAS 0.332 0.17 0.431 0.06 1987.71 0.02

Each model is compared to MINT_Awareness.

Code
preds_cerqreapp$p

Code
mods_cerqreapp <- compare_models_lm("CERQ_PositiveReappraisal")
display(mods_cerqreapp, title="CERQ - Positive Reappraisal")
CERQ - Positive Reappraisal
Name BF LR p (LR) R2 BIC
m_mint 0.10 2024.82
m_metamint > 1000 2.23 0.013 0.07 1994.86
m_minimint > 1000 2.76 0.003 0.05 2007.83
m_micromint 44.67 3.16 < .001 0.04 2017.22
m_maia > 1000 -3.61 < .001 0.21 1908.44
m_imaia > 1000 -0.55 0.293 0.11 1960.87
m_ias > 1000 1.67 0.048 0.06 1987.71
m_bpq 7.06 3.30 < .001 0.02 2020.91

Each model is compared to m_mint.

Code
preds_cerqrefocus <- compare_predictors("CERQ_PositiveRefocusing")
display(preds_cerqrefocus$table, title="CERQ - Positive Refocusing")
CERQ - Positive Refocusing
Name BF LR p (LR) R2 BIC Coefficient
MINT_RelA 0.06 2108.34 0.21
MAIA_SelfRegulation > 1000 -2.90 0.002 0.14 2045.49 0.29
BPQ < 0.001 2.99 0.001 0.00 2152.33 0.05
IAS < 0.001 2.07 0.019 0.02 2135.43 0.02

Each model is compared to MINT_RelA.

Code
preds_cerqrefocus$p

Code
mods_cerqrefocus <- compare_models_lm("CERQ_PositiveRefocusing")
display(mods_cerqrefocus, title="CERQ - Positive Refocusing")
CERQ - Positive Refocusing
Name BF LR p (LR) R2 BIC
m_mint 0.07 2163.05
m_metamint > 1000 2.45 0.007 0.04 2136.82
m_minimint > 1000 2.28 0.011 0.04 2133.84
m_micromint > 1000 2.77 0.003 0.03 2147.23
m_maia > 1000 -4.17 < .001 0.19 2043.21
m_imaia > 1000 -0.94 0.172 0.10 2092.09
m_ias > 1000 2.46 0.007 0.02 2135.43
m_bpq 213.01 3.31 < .001 0.00 2152.33

Each model is compared to m_mint.

Code
preds_cerqpersp <- compare_predictors("CERQ_Perspective")
display(preds_cerqpersp$table, title="CERQ - Perspective")
CERQ - Perspective
Name BF LR p (LR) R2 BIC Coefficient
MINT_Awareness 0.04 1939.81 0.24
MAIA_AttentionRegulation > 1000 -1.81 0.035 0.08 1907.97 0.24
BPQ < 0.001 2.23 0.013 0.01 1966.83 0.09
IAS 0.119 0.43 0.333 0.04 1944.07 0.02

Each model is compared to MINT_Awareness.

Code
preds_cerqpersp$p

Code
mods_cerqpersp <- compare_models_lm("CERQ_Perspective")
display(mods_cerqpersp, title="CERQ - Perspective")
CERQ - Perspective
Name BF LR p (LR) R2 BIC
m_mint 0.07 1988.72
m_metamint > 1000 1.68 0.046 0.05 1951.29
m_minimint > 1000 2.05 0.020 0.04 1959.08
m_micromint > 1000 2.42 0.008 0.03 1966.07
m_maia > 1000 -3.06 0.001 0.16 1892.96
m_imaia > 1000 1.97 0.024 0.03 1964.20
m_ias > 1000 1.43 0.076 0.04 1944.07
m_bpq > 1000 2.97 0.001 0.01 1966.83

Each model is compared to m_mint.

Code
preds_cerqacceptance <- compare_predictors("CERQ_Acceptance")
display(preds_cerqacceptance$table, title="CERQ - Acceptance")
CERQ - Acceptance
Name BF LR p (LR) R2 BIC Coefficient
MINT_Awareness 0.02 1870.51 0.14
MAIA_NotDistracting 5.87 -0.31 0.379 0.02 1866.98 -0.13
BPQ 0.027 0.88 0.190 0.01 1877.74 0.09
IAS 0.339 0.36 0.358 0.02 1872.68 0.01

Each model is compared to MINT_Awareness.

Code
preds_cerqacceptance$p

Code
mods_cerqacceptance <- compare_models_lm("CERQ_Acceptance")
display(mods_cerqacceptance, title="CERQ - Acceptance")
CERQ - Acceptance
Name BF LR p (LR) R2 BIC
m_mint 0.03 1923.83
m_metamint > 1000 1.39 0.082 0.02 1879.76
m_minimint > 1000 1.68 0.047 0.02 1883.76
m_micromint > 1000 1.92 0.027 0.01 1886.77
m_maia > 1000 -0.82 0.205 0.05 1892.94
m_imaia > 1000 0.81 0.209 0.02 1879.39
m_ias > 1000 1.48 0.069 0.02 1872.68
m_bpq > 1000 1.92 0.028 0.01 1877.74

Each model is compared to m_mint.

Code
make_cor(select(df, starts_with("MINT"), -matches("[[:digit:]]")), 
         select(df, starts_with("PI")))
Warning: Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.
Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.

Code
make_cor(select(df, starts_with("MAIA"), IAS, BPQ), 
         select(df, starts_with("PI")))
Warning: Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.
Vectorized input to `element_text()` is not officially supported.
ℹ Results may be unexpected or may change in future versions of ggplot2.

Code
preds_pialive <- compare_predictors("PI_Alive")
display(preds_pialive$table, title="Primals - Alive")
Primals - Alive
Name BF LR p (LR) R2 BIC Coefficient
MINT_Visceroception 0.07 2374.58 0.28
MAIA_EmotionalAwareness > 1000 -2.10 0.018 0.13 2331.48 0.39
BPQ < 0.001 3.24 < .001 0.02 2418.47 0.17
IAS 0.006 0.57 0.285 0.06 2384.87 0.03

Each model is compared to MINT_Visceroception.

Code
preds_pialive$p

Code
mods_pialive <- compare_models_lm("PI_Alive")
display(mods_pialive, title="Primals - Alive")
Primals - Alive
Name BF LR p (LR) R2 BIC
m_mint 0.13 2394.67
m_metamint > 1000 2.65 0.004 0.09 2369.95
m_minimint > 1000 2.32 0.010 0.10 2363.89
m_micromint 163.03 3.22 < .001 0.08 2384.48
m_maia > 1000 -1.60 0.055 0.17 2337.51
m_imaia > 1000 -0.74 0.229 0.15 2325.77
m_ias 134.32 2.99 0.001 0.06 2384.87
m_bpq < 0.001 4.91 < .001 0.02 2418.47

Each model is compared to m_mint.

Code
preds_pisafe <- compare_predictors("PI_Safe")
display(preds_pisafe$table, title="Primals - Safe")
Primals - Safe
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.12 1775.84 -0.34
MAIA_Trusting > 1000 -0.96 0.168 0.15 1750.87 0.25
BPQ < 0.001 3.15 < .001 0.05 1836.76 -0.20
IAS < 0.001 3.17 < .001 0.04 1842.84 0.02

Each model is compared to MINT_Deficit.

Code
preds_pisafe$p

Code
mods_pisafe <- compare_models_lm("PI_Safe")
display(mods_pisafe, title="Primals - Safe")
Primals - Safe
Name BF LR p (LR) R2 BIC
m_mint 0.18 1794.07
m_metamint > 1000 2.32 0.010 0.15 1763.83
m_minimint 1.91 3.62 < .001 0.12 1792.78
m_micromint < 0.001 4.52 < .001 0.09 1819.00
m_maia > 1000 -1.54 0.062 0.23 1728.15
m_imaia < 0.001 6.14 < .001 0.00 1883.38
m_ias < 0.001 4.90 < .001 0.04 1842.84
m_bpq < 0.001 4.46 < .001 0.05 1836.76

Each model is compared to m_mint.

Code
preds_pient <- compare_predictors("PI_Enticing")
display(preds_pient$table, title="Primals - Enticing")
Primals - Enticing
Name BF LR p (LR) R2 BIC Coefficient
MINT_Awareness 0.07 1725.24 0.26
MAIA_Trusting > 1000 -2.86 0.002 0.14 1663.95 0.22
BPQ < 0.001 3.40 < .001 0.00 1776.61 -0.01
IAS 0.391 0.12 0.454 0.06 1727.12 0.02

Each model is compared to MINT_Awareness.

Code
preds_pient$p

Code
mods_pient <- compare_models_lm("PI_Enticing")
display(mods_pient, title="Primals - Enticing")
Primals - Enticing
Name BF LR p (LR) R2 BIC
m_mint 0.11 1753.01
m_metamint > 1000 1.59 0.056 0.10 1710.93
m_minimint 395.91 3.25 < .001 0.06 1741.05
m_micromint 1.92 3.51 < .001 0.05 1751.70
m_maia > 1000 -1.93 0.027 0.17 1685.31
m_imaia 0.017 3.14 < .001 0.04 1761.18
m_ias > 1000 2.04 0.021 0.06 1727.12
m_bpq < 0.001 4.76 < .001 0.00 1776.61

Each model is compared to m_mint.

Code
preds_pigood <- compare_predictors("PI_Good")
display(preds_pigood$table, title="Primals - Good")
Primals - Good
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.10 1526.10 -0.26
MAIA_Trusting > 1000 -2.94 0.002 0.20 1444.02 0.23
BPQ < 0.001 3.87 < .001 0.02 1593.21 -0.10
IAS < 0.001 1.27 0.102 0.07 1554.19 0.02

Each model is compared to MINT_Deficit.

Code
preds_pigood$p

Code
mods_pigood <- compare_models_lm("PI_Good")
display(mods_pigood, title="Primals - Good")
Primals - Good
Name BF LR p (LR) R2 BIC
m_mint 0.17 1530.74
m_metamint > 1000 1.77 0.038 0.16 1490.62
m_minimint 2.92 3.69 < .001 0.12 1528.60
m_micromint < 0.001 4.29 < .001 0.09 1553.14
m_maia > 1000 -2.28 0.011 0.25 1438.30
m_imaia < 0.001 5.54 < .001 0.02 1608.05
m_ias < 0.001 3.65 < .001 0.07 1554.19
m_bpq < 0.001 5.22 < .001 0.02 1593.21

Each model is compared to m_mint.

Predictive

Mental Health

Code
compare_models_glm <- function(outcome="Disorders_Psychiatric_Mood", title="", subtitle = "") {
  
  # Full Questionnaires
  m_mint <- glm(as.formula(paste0(outcome, " ~ .")),
              data = cbind(mint, df[outcome]),
              family = "binomial")
  m_metamint <- glm(as.formula(paste0(outcome, " ~ .")),
              data = cbind(metamint, df[outcome]),
              family = "binomial")
  m_minimint <- glm(as.formula(paste0(outcome, " ~ .")),
              data = cbind(minimint, df[outcome]),
              family = "binomial") 
  m_micromint <- glm(as.formula(paste0(outcome, " ~ .")),
              data = cbind(micromint, df[outcome]),
              family = "binomial") 
  m_ias <- glm(as.formula(paste0(outcome, " ~ IAS")),
              data = df,
              family = "binomial")
  m_maia <- glm(as.formula(paste0(outcome, " ~ .")),
                data = select(df, all_of(outcome), starts_with("MAIA")),
              family = "binomial") 
  m_imaia <- glm(as.formula(paste0(outcome, " ~ .")),
                data = select(df, all_of(outcome), 
                              starts_with("MAIA"), 
                              -contains("NotWorrying"),
                              -contains("NotDistracting")),
              family = "binomial")
  m_imaia <- glm(as.formula(paste0(outcome, " ~ .")),
                data = select(df, all_of(outcome),
                              # MAIA_AttentionRegulation, # remove?
                              # MAIA_SelfRegulation, # remove?
                              # MAIA_Trusting, # remove?
                              MAIA_BodyListening, 
                              MAIA_EmotionalAwareness,
                              MAIA_Noticing),
              family = "binomial")
  m_bpq <- glm(as.formula(paste0(outcome, " ~ BPQ")),
               data = df,
               family = "binomial")
  
  models_full <- list(m_mint=m_mint, m_metamint=m_metamint, 
                      m_minimint=m_minimint, m_micromint=m_micromint,
                      m_maia=m_maia, m_imaia=m_imaia, 
                      m_ias=m_ias, m_bpq=m_bpq)
  
  table <- table_models(models_full)

  get_auc <- function(m) {
    roc <- as.data.frame(performance_roc(m))
    auc <- bayestestR::area_under_curve(roc$Specificity, roc$Sensitivity)
    paste0("AUC = ", insight::format_percent(auc))
  }
  
  mods_order <- c("Mint", "metaMint", "miniMint", "microMint", "MAIA", "iMAIA", "IAS", "BPQ")

  p <- rbind(
    mutate(as.data.frame(performance_roc(m_mint)), Predictor = "Mint"),
    mutate(as.data.frame(performance_roc(m_metamint)), Predictor = "metaMint"),
    mutate(as.data.frame(performance_roc(m_minimint)), Predictor = "miniMint"),
    mutate(as.data.frame(performance_roc(m_micromint)), Predictor = "microMint"),
    mutate(as.data.frame(performance_roc(m_maia)), Predictor = "MAIA"),
    mutate(as.data.frame(performance_roc(m_imaia)), Predictor = "iMAIA"),
    mutate(as.data.frame(performance_roc(m_ias)), Predictor = "IAS"),
    mutate(as.data.frame(performance_roc(m_bpq)), Predictor = "BPQ")
  ) |>
    mutate(Predictor = fct_relevel(Predictor, mods_order)) |>
    ggplot(aes(x=Specificity)) +
    geom_abline(intercept=0, slope=1, color="gray", linewidth=1) +
    geom_line(aes(y=Sensitivity, color=Predictor), linewidth=1.5, alpha=0.9) +
    geom_label(data=data.frame(
      label = c(get_auc(m_mint), get_auc(m_metamint), 
                get_auc(m_minimint), get_auc(m_micromint), 
                get_auc(m_maia), get_auc(m_imaia), get_auc(m_ias), get_auc(m_bpq)),
      Predictor = mods_order,
      x = 0.8,
      y = c(0.55, 0.475, 0.425, 0.375, 0.30, 0.25, 0.20, 0.15)),
      aes(x=x, y=y, label=label), color=colors[mods_order], size=3) +
    labs(x= "1 - Specificity (False Positive Rate)", y="Sensitivity (True Positive Rate)",
         color="Questionnaire", title = title, subtitle=subtitle) +
    scale_color_manual(values=colors) +
    scale_x_continuous(labels=scales::percent) +
    scale_y_continuous(labels=scales::percent) +
    theme_minimal() +
    theme(plot.title = element_text(face="bold"))
  
  list(table=table, p=p)
}
Code
preds_mood <- compare_predictors("Disorders_Psychiatric_Mood")
display(preds_mood$table, title="Mood Disorders")
Mood Disorders
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.07 647.74 0.75
MAIA_Trusting > 1000 -1.10 0.136 0.10 628.01 -0.84
BPQ < 0.001 3.41 < .001 0.01 693.45 0.25
IAS < 0.001 3.45 < .001 0.00 697.06 -0.16

Each model is compared to MINT_Deficit.

Code
preds_mood$p

Code
mods_mood <- compare_models_glm("Disorders_Psychiatric_Mood")
display(mods_mood$table, title="Mood Disorders")
Mood Disorders
Name BF LR p (LR) R2 BIC
m_mint 0.11 693.59
m_metamint > 1000 1.57 0.058 0.09 651.91
m_minimint > 1000 2.29 0.011 0.08 660.53
m_micromint > 1000 2.29 0.011 0.07 664.76
m_maia > 1000 -2.67 0.004 0.18 624.14
m_imaia < 0.001 4.13 < .001 0.00 710.98
m_ias 0.176 4.09 < .001 0.00 697.06
m_bpq 1.07 4.11 < .001 0.01 693.45

Each model is compared to m_mint.

Code
mods_mood$p

Code
preds_moodt <- compare_predictors("Disorders_Psychiatric_MoodTreatment")
display(preds_moodt$table, title="Mood Disorders (with Treatment)")
Mood Disorders (with Treatment)
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.06 452.33 0.84
MAIA_Trusting 387.73 -0.81 0.210 0.08 440.41 -0.90
BPQ < 0.001 3.07 0.001 0.00 489.91 0.24
IAS < 0.001 2.76 0.003 0.01 488.61 -0.27

Each model is compared to MINT_Deficit.

Code
preds_moodt$p

Code
mods_moodt <- compare_models_glm("Disorders_Psychiatric_MoodTreatment",
                                 title="Mood Disorders", subtitle = "MDD, GAD, Bipolar (with Treatment)")
display(mods_moodt$table, title="Mood Disorders (with Treatment)")
Mood Disorders (with Treatment)
Name BF LR p (LR) R2 BIC
m_mint 0.09 501.95
m_metamint > 1000 1.46 0.072 0.08 456.71
m_minimint > 1000 2.58 0.005 0.06 469.91
m_micromint > 1000 2.21 0.014 0.06 469.83
m_maia > 1000 -2.29 0.011 0.17 445.54
m_imaia 0.243 3.61 < .001 0.00 504.78
m_ias 790.65 3.59 < .001 0.01 488.61
m_bpq 412.07 3.65 < .001 0.00 489.91

Each model is compared to m_mint.

Code
mods_moodt$p

Code
preds_anxdis <- compare_predictors("Disorders_Psychiatric_Anxiety")
display(preds_anxdis$table, title="Anxiety Disorders")
Anxiety Disorders
Name BF LR p (LR) R2 BIC Coefficient
MINT_CaCo 0.05 686.43 0.58
MAIA_Trusting > 1000 -1.68 0.047 0.09 658.48 -0.78
BPQ < 0.001 2.63 0.004 0.01 716.72 0.26
IAS < 0.001 3.05 0.001 0.00 722.92 -0.10

Each model is compared to MINT_CaCo.

Code
preds_anxdis$p

Code
mods_anxdis <- compare_models_glm("Disorders_Psychiatric_Anxiety")
display(mods_anxdis$table, title="Anxiety Disorders")
Anxiety Disorders
Name BF LR p (LR) R2 BIC
m_mint 0.09 729.31
m_metamint > 1000 1.87 0.030 0.06 693.26
m_minimint > 1000 1.98 0.024 0.06 692.87
m_micromint > 1000 2.22 0.013 0.05 699.61
m_maia > 1000 -3.45 < .001 0.19 646.25
m_imaia 0.068 3.74 < .001 0.00 734.68
m_ias 24.33 3.86 < .001 0.00 722.92
m_bpq 540.19 3.64 < .001 0.01 716.72

Each model is compared to m_mint.

Code
mods_anxdis$p

Code
preds_anxdist <- compare_predictors("Disorders_Psychiatric_AnxietyTreatment")
display(preds_anxdist$table, title="Anxiety Disorders (with Treatment)")
Anxiety Disorders (with Treatment)
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.03 398.02 0.58
MAIA_Trusting 237.81 -0.98 0.163 0.05 387.08 -0.71
BPQ 0.002 1.49 0.068 0.01 410.01 0.30
IAS < 0.001 1.78 0.038 0.00 413.57 -0.13

Each model is compared to MINT_Deficit.

Code
preds_anxdist$p

Code
mods_anxdist <- compare_models_glm("Disorders_Psychiatric_AnxietyTreatment")
display(mods_anxdist$table, title="Anxiety Disorders (with Treatment)")
Anxiety Disorders (with Treatment)
Name BF LR p (LR) R2 BIC
m_mint 0.04 457.93
m_metamint > 1000 0.85 0.197 0.03 409.34
m_minimint > 1000 1.32 0.094 0.02 412.24
m_micromint > 1000 1.43 0.076 0.02 415.54
m_maia > 1000 -2.62 0.004 0.13 400.96
m_imaia > 1000 1.71 0.043 0.01 422.88
m_ias > 1000 1.91 0.028 0.00 413.57
m_bpq > 1000 1.79 0.037 0.01 410.01

Each model is compared to m_mint.

Code
mods_anxdist$p

Code
preds_eat <- compare_predictors("Disorders_Psychiatric_Eating")
display(preds_eat$table, title="Eating Disorders")
Eating Disorders
Name BF LR p (LR) R2 BIC Coefficient
MINT_CaCo 0.03 166.00 0.96
MAIA_Trusting 480.64 -1.21 0.113 0.06 153.65 -1.29
BPQ < 0.001 1.96 0.025 0.00 182.40 0.00
IAS 0.006 1.06 0.145 0.01 176.17 -0.58

Each model is compared to MINT_CaCo.

Code
preds_eat$p

Code
mods_eat <- compare_models_glm("Disorders_Psychiatric_Eating")
display(mods_eat$table, title="Eating Disorders")
Eating Disorders
Name BF LR p (LR) R2 BIC
m_mint 0.07 217.25
m_metamint > 1000 0.63 0.265 0.06 167.68
m_minimint > 1000 1.26 0.104 0.06 169.36
m_micromint > 1000 1.83 0.034 0.04 173.90
m_maia > 1000 -0.41 0.340 0.10 192.60
m_imaia > 1000 2.42 0.008 0.00 193.17
m_ias > 1000 2.25 0.012 0.01 176.17
m_bpq > 1000 2.57 0.005 0.00 182.40

Each model is compared to m_mint.

Code
mods_eat$p

Code
preds_addict <- compare_predictors("Disorders_Psychiatric_Addiction")
display(preds_addict$table, title="Addiction")
Addiction
Name BF LR p (LR) R2 BIC Coefficient
MINT_SexS 0.01 207.84 0.45
MAIA_Noticing 0.575 0.30 0.381 0.00 208.95 0.32
BPQ 0.379 0.41 0.340 0.00 209.78 0.25
IAS 0.244 0.70 0.242 0.00 210.66 0.14

Each model is compared to MINT_SexS.

Code
preds_addict$p

Code
mods_addict <- compare_models_glm("Disorders_Psychiatric_Addiction")
display(mods_addict$table, title="Addiction")
Addiction
Name BF LR p (LR) R2 BIC
m_mint 0.01 269.86
m_metamint > 1000 0.82 0.206 0.00 220.52
m_minimint > 1000 0.94 0.174 0.00 222.45
m_micromint > 1000 0.93 0.176 0.00 221.82
m_maia > 1000 -0.22 0.414 0.01 248.58
m_imaia > 1000 0.87 0.191 0.00 221.76
m_ias > 1000 1.23 0.109 0.00 210.66
m_bpq > 1000 1.01 0.157 0.00 209.78

Each model is compared to m_mint.

Code
mods_addict$p

Code
preds_adhd <- compare_predictors("Disorders_Psychiatric_ADHD")
display(preds_adhd$table, title="ADHD")
ADHD
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.03 432.89 0.60
MAIA_Trusting 0.007 1.12 0.132 0.01 442.91 -0.40
BPQ < 0.001 2.13 0.017 0.00 452.19 0.11
IAS 0.040 0.55 0.290 0.02 439.30 -0.48

Each model is compared to MINT_Deficit.

Code
preds_adhd$p

Code
mods_adhd <- compare_models_glm("Disorders_Psychiatric_ADHD",
                                title = "ADHD", subtitle = "Attention Deficit/Hyperactivity Disorder")
display(mods_adhd$table, title="ADHD")
ADHD
Name BF LR p (LR) R2 BIC
m_mint 0.07 478.24
m_metamint > 1000 1.58 0.057 0.05 434.60
m_minimint > 1000 1.62 0.053 0.05 438.84
m_micromint > 1000 2.24 0.012 0.02 450.87
m_maia 0.244 1.80 0.036 0.03 481.06
m_imaia 905.92 2.66 0.004 0.00 464.63
m_ias > 1000 2.14 0.016 0.02 439.30
m_bpq > 1000 2.75 0.003 0.00 452.19

Each model is compared to m_mint.

Code
mods_adhd$p

Code
preds_asd <- compare_predictors("Disorders_Psychiatric_Autism")
display(preds_asd$table, title="Autism")
Autism
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.03 367.12 0.71
MAIA_Trusting 0.076 0.58 0.280 0.02 372.28 -0.58
BPQ < 0.001 2.36 0.009 0.00 388.27 0.14
IAS 0.005 0.96 0.170 0.02 377.64 -0.48

Each model is compared to MINT_Deficit.

Code
preds_asd$p

Code
mods_asd <- compare_models_glm("Disorders_Psychiatric_Autism",
                                title = "ASD", subtitle = "Autism Spectrum Disorder")
display(mods_asd$table, title="Autism")
Autism
Name BF LR p (LR) R2 BIC
m_mint 0.08 410.51
m_metamint > 1000 1.39 0.082 0.06 367.41
m_minimint > 1000 1.89 0.029 0.04 376.40
m_micromint > 1000 2.51 0.006 0.02 389.04
m_maia 0.168 1.76 0.039 0.03 414.07
m_imaia 139.07 2.96 0.002 0.00 400.64
m_ias > 1000 2.35 0.009 0.02 377.64
m_bpq > 1000 2.97 0.002 0.00 388.27

Each model is compared to m_mint.

Code
mods_asd$p

Code
preds_bpd <- compare_predictors("Disorders_Psychiatric_Borderline")
display(preds_bpd$table, title="Borderline Personality Disorder")
Borderline Personality Disorder
Name BF LR p (LR) R2 BIC Coefficient
MINT_Derm 0.01 74.62 1.59
MAIA_EmotionalAwareness 6.78 -0.67 0.251 0.02 70.79 1.93
BPQ 0.647 0.13 0.446 0.01 75.49 1.31
IAS 0.018 1.45 0.073 0.00 82.71 0.17

Each model is compared to MINT_Derm.

Code
preds_bpd$p

Code
mods_bpd <- compare_models_glm("Disorders_Psychiatric_Borderline")
display(mods_bpd$table, title="Borderline Personality Disorder")
Borderline Personality Disorder
Name BF LR p (LR) R2 BIC
m_mint 0.18 120.21
m_metamint > 1000 1.79 0.037 0.02 85.38
m_minimint > 1000 1.56 0.060 0.03 85.37
m_micromint > 1000 1.37 0.085 0.04 85.38
m_maia > 1000 -0.89 0.188 0.38 87.65
m_imaia > 1000 0.97 0.166 0.07 78.69
m_ias > 1000 1.96 0.025 0.00 82.71
m_bpq > 1000 1.62 0.053 0.01 75.49

Each model is compared to m_mint.

Code
mods_bpd$p

Somatic Issues

Code
preds_afferent <- compare_predictors("Disorders_Somatic_AfferentSensitivity")
display(preds_afferent$table, title="Afferent Sensitivity Symptoms")
Afferent Sensitivity Symptoms
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.04 738.45 0.50
MAIA_Trusting 0.003 1.07 0.143 0.02 750.22 -0.36
BPQ < 0.001 2.54 0.006 0.00 763.36 0.15
IAS < 0.001 2.52 0.006 0.00 764.33 -0.12

Each model is compared to MINT_Deficit.

Code
preds_afferent$p

Code
mods_afferent <- compare_models_glm("Disorders_Somatic_AfferentSensitivity",
                                    title="Afferent Sensitivity Symptoms",
                                    subtitle = "Migraine, neuropathy, muscle tension, dizziness, ...")
display(mods_afferent$table, title="Afferent Sensitivity Symptoms")
Afferent Sensitivity Symptoms
Name BF LR p (LR) R2 BIC
m_mint 0.06 787.90
m_metamint > 1000 1.85 0.032 0.04 749.77
m_minimint > 1000 1.93 0.027 0.04 750.39
m_micromint > 1000 2.49 0.006 0.03 759.68
m_maia 43.07 0.96 0.170 0.05 780.38
m_imaia 75.75 3.50 < .001 0.00 779.25
m_ias > 1000 3.44 < .001 0.00 764.33
m_bpq > 1000 3.40 < .001 0.00 763.36

Each model is compared to m_mint.

Code
mods_afferent$p

Code
preds_central <- compare_predictors("Disorders_Somatic_CentralSensitization")
display(preds_central$table, title="Central Sensitization Symptoms")
Central Sensitization Symptoms
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.03 860.88 0.38
MAIA_Trusting 0.607 0.09 0.464 0.03 861.87 -0.36
BPQ < 0.001 2.09 0.018 0.00 879.09 0.11
IAS < 0.001 2.06 0.020 0.00 880.18 -0.06

Each model is compared to MINT_Deficit.

Code
preds_central$p

Code
mods_central <- compare_models_glm("Disorders_Somatic_CentralSensitization",
                                   title="Central Sensitization Symptoms",
                                   subtitle = "Fibromyalgia, chronic fatigue, back pain, IBS, ...")
display(mods_central$table, title="Central Sensitization Symptoms")
Central Sensitization Symptoms
Name BF LR p (LR) R2 BIC
m_mint 0.05 908.13
m_metamint > 1000 1.88 0.030 0.03 870.25
m_minimint > 1000 2.19 0.014 0.03 875.21
m_micromint > 1000 2.63 0.004 0.01 884.89
m_maia > 1000 -0.57 0.285 0.06 880.20
m_imaia > 1000 2.66 0.004 0.00 890.41
m_ias > 1000 3.04 0.001 0.00 880.18
m_bpq > 1000 2.99 0.001 0.00 879.09

Each model is compared to m_mint.

Code
mods_central$p

Code
preds_autonomic <- compare_predictors("Disorders_Somatic_AutonomicDysfunction")
display(preds_autonomic$table, title="Autonomic Dysfunction")
Autonomic Dysfunction
Name BF LR p (LR) R2 BIC Coefficient
MINT_Card 0.03 698.65 0.46
MAIA_Trusting < 0.001 1.75 0.040 0.01 716.70 -0.20
BPQ < 0.001 2.13 0.017 0.00 717.74 0.17
IAS < 0.001 2.30 0.011 0.00 720.99 -0.02

Each model is compared to MINT_Card.

Code
preds_autonomic$p

Code
mods_autonomic <- compare_models_glm("Disorders_Somatic_AutonomicDysfunction",
                                     title="Autonomic Dysfunction",
                                     subtitle = "Hypermobility, chest pain, hypo/hypertension, ....")
display(mods_autonomic$table, title="Autonomic Dysfunction")
Autonomic Dysfunction
Name BF LR p (LR) R2 BIC
m_mint 0.07 736.12
m_metamint 494.59 3.07 0.001 0.01 723.71
m_minimint > 1000 2.57 0.005 0.03 711.21
m_micromint > 1000 2.99 0.001 0.02 720.48
m_maia 0.003 1.93 0.027 0.03 748.02
m_imaia 10.85 3.29 < .001 0.00 731.35
m_ias > 1000 3.49 < .001 0.00 720.99
m_bpq > 1000 3.31 < .001 0.00 717.74

Each model is compared to m_mint.

Code
mods_autonomic$p

Code
preds_immune <- compare_predictors("Disorders_Somatic_ImmuneInflammatory")
display(preds_immune$table, title="Immune-Inflammatory Symptoms")
Immune-Inflammatory Symptoms
Name BF LR p (LR) R2 BIC Coefficient
MINT_Derm 0.07 891.57 0.60
MAIA_Trusting < 0.001 1.86 0.032 0.03 921.09 -0.36
BPQ < 0.001 2.87 0.002 0.01 931.00 0.26
IAS < 0.001 3.38 < .001 0.00 940.64 -0.09

Each model is compared to MINT_Derm.

Code
preds_immune$p

Code
mods_immune <- compare_models_glm("Disorders_Somatic_ImmuneInflammatory",
                                  title="Immune-Inflammatory Symptoms",
                                  subtitle = "Allergies, asthma, eczema, autoimmune, ...")
display(mods_immune$table, title="Immune-Inflammatory Symptoms")
Immune-Inflammatory Symptoms
Name BF LR p (LR) R2 BIC
m_mint 0.10 934.15
m_metamint > 1000 3.07 0.001 0.05 919.15
m_minimint 33.21 3.43 < .001 0.04 927.14
m_micromint 4.52 3.56 < .001 0.03 931.13
m_maia 0.018 1.66 0.049 0.06 942.14
m_imaia < 0.001 4.16 < .001 0.00 951.87
m_ias 0.039 4.36 < .001 0.00 940.64
m_bpq 4.84 3.82 < .001 0.01 931.00

Each model is compared to m_mint.

Code
mods_immune$p

Lifestyle and Demographic

Code
preds_age <- compare_predictors("Age")
display(preds_age$table, title="Age")
Age
Name BF LR p (LR) R2 BIC Coefficient
MINT_Deficit 0.08 6033.91 -4.78
MAIA_NotWorrying < 0.001 1.69 0.046 0.04 6061.48 2.74
BPQ < 0.001 3.61 < .001 0.01 6084.98 -1.93
IAS < 0.001 1.64 0.050 0.04 6062.47 0.29

Each model is compared to MINT_Deficit.

Code
preds_age$p

Code
mods_age <- compare_models_lm("Age")
display(mods_age, title="Age")
Age
Name BF LR p (LR) R2 BIC
m_mint 0.17 6024.63
m_metamint 29.55 3.38 < .001 0.12 6017.86
m_minimint < 0.001 4.60 < .001 0.07 6051.36
m_micromint < 0.001 4.62 < .001 0.07 6050.92
m_maia < 0.001 3.01 0.001 0.09 6074.60
m_imaia < 0.001 6.34 < .001 0.00 6106.72
m_ias < 0.001 4.87 < .001 0.04 6062.47
m_bpq < 0.001 6.01 < .001 0.01 6084.98

Each model is compared to m_mint.

Code
df$Sex <- ifelse(df$Gender == "Female", 1, ifelse(df$Gender == "Male", 0, NA))

preds_sex <- compare_predictors("Sex")
display(preds_sex$table, title="Sex")
Sex
Name BF LR p (LR) R2 BIC Coefficient
MINT_CaCo 0.06 1004.87 0.08
MAIA_NotWorrying 0.006 0.67 0.252 0.05 1015.26 -0.10
BPQ < 0.001 3.44 < .001 0.00 1050.06 0.03
IAS < 0.001 3.53 < .001 0.00 1052.23 0.00

Each model is compared to MINT_CaCo.

Code
preds_sex$p

Code
mods_sex <- compare_models_glm("Sex")
display(mods_sex$table, title="Sex")
Sex
Name BF LR p (LR) R2 BIC
m_mint 0.16 944.58
m_metamint 37.74 3.43 < .001 0.10 937.32
m_minimint 0.008 4.01 < .001 0.08 954.29
m_micromint 0.349 3.76 < .001 0.09 946.68
m_maia < 0.001 2.59 0.005 0.09 980.74
m_imaia < 0.001 5.47 < .001 0.01 1007.96
m_ias < 0.001 5.91 < .001 0.00 998.49
m_bpq < 0.001 5.80 < .001 0.00 996.33

Each model is compared to m_mint.

Code
mods_sex$p

Code
preds_bmi <- compare_predictors("BMI")
display(preds_bmi$table, title="BMI")
BMI
Name BF LR p (LR) R2 BIC Coefficient
MINT_Sati 0.03 4873.64 -0.89
MAIA_NotWorrying < 0.001 1.75 0.040 0.01 4890.73 0.44
BPQ < 0.001 2.09 0.018 0.00 4894.04 -0.17
IAS < 0.001 1.59 0.056 0.01 4889.49 0.06

Each model is compared to MINT_Sati.

Code
preds_bmi$p

Code
mods_bmi <- compare_models_lm("BMI")
display(mods_bmi, title="BMI")
BMI
Name BF LR p (LR) R2 BIC
m_mint 0.05 4922.00
m_metamint > 1000 2.34 0.010 0.02 4894.07
m_minimint > 1000 2.52 0.006 0.01 4899.62
m_micromint > 1000 2.30 0.011 0.02 4893.35
m_maia 0.002 2.40 0.008 0.01 4934.85
m_imaia > 1000 2.78 0.003 0.00 4906.31
m_ias > 1000 2.60 0.005 0.01 4889.49
m_bpq > 1000 2.90 0.002 0.00 4894.04

Each model is compared to m_mint.

Code
preds_physactiv <- compare_predictors("Physical_Active")
display(preds_physactiv$table, title="Physical Activity")
Physical Activity
Name BF LR p (LR) R2 BIC Coefficient
MINT_RelA 0.05 2911.58 0.32
MAIA_Trusting > 1000 -3.70 < .001 0.13 2844.29 0.47
BPQ < 0.001 2.89 0.002 0.00 2946.74 0.01
IAS < 0.001 1.96 0.025 0.02 2932.91 0.02

Each model is compared to MINT_RelA.

Code
preds_physactiv$p

Code
mods_physactiv <- compare_models_lm("Physical_Active")
display(mods_physactiv, title="Physical Activity")
Physical Activity
Name BF LR p (LR) R2 BIC
m_mint 0.09 2940.44
m_metamint > 1000 2.44 0.007 0.06 2911.50
m_minimint > 1000 2.12 0.017 0.07 2906.06
m_micromint > 1000 2.15 0.016 0.07 2907.55
m_maia > 1000 -2.23 0.013 0.15 2876.67
m_imaia > 1000 1.20 0.116 0.06 2910.64
m_ias 43.15 3.99 < .001 0.02 2932.91
m_bpq 0.043 4.38 < .001 0.00 2946.74

Each model is compared to m_mint.

Biofeedback Usage (Wearables)

Code
preds_wearN <- compare_predictors("Wearables_Number", family = "poisson")
display(preds_wearN$table, title="Wearables Number")
Wearables Number
Name BF LR p (LR) R2 BIC Coefficient
MINT_SexS 0.02 2969.56 0.08
MAIA_SelfRegulation 1.06 -0.01 0.496 0.02 2969.43 0.07
BPQ 0.003 1.16 0.123 0.00 2980.92 -0.01
IAS 0.005 1.17 0.122 0.00 2979.99 0.00

Each model is compared to MINT_SexS.

Code
preds_wearN$p

Code
df$Wearables_HeartOwn <- ifelse(df$Wearables_Heart == "Not owning", 0, 1) 
preds_wearHeartOwn <- compare_predictors("Wearables_HeartOwn")
display(preds_wearHeartOwn$table, title="Wearables Heart Ownership")
Wearables Heart Ownership
Name BF LR p (LR) R2 BIC Coefficient
MINT_Resp 0.01 957.73 0.24
MAIA_SelfRegulation 15.00 -0.60 0.274 0.02 952.31 0.31
BPQ 0.012 1.19 0.117 0.00 966.60 -0.08
IAS 0.026 1.15 0.126 0.00 964.99 0.13

Each model is compared to MINT_Resp.

Code
preds_wearHeartOwn$p

Code
mods_wearHeartOwn <- compare_models_glm("Wearables_HeartOwn")
display(mods_wearHeartOwn$table, title="Wearables Heart Ownership")
Wearables Heart Ownership
Name BF LR p (LR) R2 BIC
m_mint 0.03 1012.46
m_metamint > 1000 1.70 0.045 0.01 971.82
m_minimint > 1000 1.71 0.043 0.01 971.79
m_micromint > 1000 1.26 0.104 0.02 966.04
m_maia > 1000 0.09 0.464 0.03 993.65
m_imaia > 1000 1.42 0.078 0.01 972.21
m_ias > 1000 2.09 0.018 0.00 964.99
m_bpq > 1000 1.99 0.023 0.00 966.60

Each model is compared to m_mint.

Code
mods_wearHeartOwn$p

Code
preds_wearHeartImp <- compare_predictors("Wearables_HeartImportance")
display(preds_wearHeartImp$table, title="Wearables Heart Importance")
Wearables Heart Importance
Name BF LR p (LR) R2 BIC Coefficient
MINT_Card 0.10 1013.08 0.37
MAIA_BodyListening 115.97 -0.64 0.262 0.13 1003.57 0.52
BPQ < 0.001 2.52 0.006 0.01 1036.81 0.20
IAS < 0.001 1.36 0.086 0.04 1027.99 0.04

Each model is compared to MINT_Card.

Code
preds_wearHeartImp$p

Code
mods_wearHeartImp <- compare_models_lm("Wearables_HeartImportance")
display(mods_wearHeartImp, title="Wearables Heart Importance")
Wearables Heart Importance
Name BF LR p (LR) R2 BIC
m_mint 0.19 1041.78
m_metamint > 1000 2.00 0.023 0.12 1017.22
m_minimint > 1000 2.23 0.013 0.10 1022.77
m_micromint 10.58 2.90 0.002 0.05 1037.06
m_maia 889.20 0.19 0.423 0.18 1028.20
m_imaia > 1000 0.80 0.212 0.15 1009.32
m_ias 987.72 3.14 < .001 0.04 1027.99
m_bpq 11.98 3.49 < .001 0.01 1036.81

Each model is compared to m_mint.

Code
df$Wearables_SleepOwn <- ifelse(df$Wearables_Sleep == "Not owning", 0, 1)
preds_wearSleepOwn <- compare_predictors("Wearables_SleepOwn")
display(preds_wearSleepOwn$table, title="Wearables Sleep Ownership")
Wearables Sleep Ownership
Name BF LR p (LR) R2 BIC Coefficient
MINT_Olfa 0.00 806.35 0.15
MAIA_SelfRegulation 1.99 -0.26 0.398 0.01 804.98 0.18
BPQ 0.235 0.84 0.201 0.00 809.25 0.01
IAS 0.269 0.73 0.232 0.00 808.98 0.05

Each model is compared to MINT_Olfa.

Code
preds_wearSleepOwn$p

Code
mods_wearSleepOwn <- compare_models_glm("Wearables_SleepOwn")
display(mods_wearSleepOwn$table, title="Wearables Sleep Ownership")
Wearables Sleep Ownership
Name BF LR p (LR) R2 BIC
m_mint 0.01 865.18
m_metamint > 1000 1.48 0.069 0.00 821.27
m_minimint > 1000 1.52 0.065 0.00 821.72
m_micromint > 1000 1.44 0.074 0.00 821.21
m_maia > 1000 0.06 0.478 0.01 845.88
m_imaia > 1000 0.95 0.170 0.00 819.45
m_ias > 1000 1.53 0.063 0.00 808.98
m_bpq > 1000 1.56 0.059 0.00 809.25

Each model is compared to m_mint.

Code
preds_wearSleepImp <- compare_predictors("Wearables_SleepImportance")
display(preds_wearSleepImp$table, title="Wearables Sleep Importance")
Wearables Sleep Importance
Name BF LR p (LR) R2 BIC Coefficient
MINT_RelA 0.05 707.28 0.33
MAIA_NotWorrying 0.932 0.02 0.493 0.05 707.42 -0.35
BPQ 0.121 0.56 0.287 0.02 711.51 0.33
IAS 0.038 1.10 0.135 0.01 713.81 0.02

Each model is compared to MINT_RelA.

Code
preds_wearSleepImp$p

Code
mods_wearSleepImp <- compare_models_lm("Wearables_SleepImportance")
display(mods_wearSleepImp, title="Wearables Sleep Importance")
Wearables Sleep Importance
Name BF LR p (LR) R2 BIC
m_mint 0.11 747.22
m_metamint > 1000 1.37 0.086 0.07 714.19
m_minimint > 1000 1.67 0.047 0.05 717.03
m_micromint > 1000 2.01 0.022 0.03 720.99
m_maia > 1000 0.09 0.463 0.11 732.76
m_imaia > 1000 1.42 0.077 0.05 716.83
m_ias > 1000 1.99 0.023 0.01 713.81
m_bpq > 1000 1.75 0.040 0.02 711.51

Each model is compared to m_mint.

Code
df$Wearables_StepsOwn <- ifelse(df$Wearables_Steps == "Not owning", 0, 1)
preds_wearStepsOwn <- compare_predictors("Wearables_StepsOwn")
display(preds_wearStepsOwn$table, title="Wearables Steps Ownership")
Wearables Steps Ownership
Name BF LR p (LR) R2 BIC Coefficient
MINT_ExaC 0.01 1030.45 -0.16
MAIA_Noticing 0.406 0.38 0.351 0.00 1032.25 -0.12
BPQ 0.257 0.58 0.282 0.00 1033.16 -0.10
IAS 0.222 0.86 0.195 0.00 1033.45 -0.09

Each model is compared to MINT_ExaC.

Code
preds_wearStepsOwn$p

Code
mods_wearStepsOwn <- compare_models_glm("Wearables_StepsOwn")
display(mods_wearStepsOwn$table, title="Wearables Steps Ownership")
Wearables Steps Ownership
Name BF LR p (LR) R2 BIC
m_mint 0.01 1090.82
m_metamint > 1000 1.42 0.078 0.00 1046.01
m_minimint > 1000 1.16 0.123 0.01 1043.38
m_micromint > 1000 1.16 0.123 0.01 1043.39
m_maia > 1000 0.29 0.385 0.01 1073.43
m_imaia > 1000 1.00 0.159 0.00 1045.00
m_ias > 1000 1.42 0.078 0.00 1033.45
m_bpq > 1000 1.24 0.108 0.00 1033.16

Each model is compared to m_mint.

Code
preds_wearStepsImp <- compare_predictors("Wearables_StepsImportance")
display(preds_wearStepsImp$table, title="Wearables Steps Importance")
Wearables Steps Importance
Name BF LR p (LR) R2 BIC Coefficient
MINT_Awareness 0.07 1477.11 0.60
MAIA_Noticing 5.68 -0.26 0.399 0.08 1473.63 0.50
BPQ < 0.001 1.63 0.052 0.02 1495.95 0.26
IAS 0.017 0.81 0.209 0.05 1485.31 0.04

Each model is compared to MINT_Awareness.

Code
preds_wearStepsImp$p

Code
mods_wearStepsImp <- compare_models_lm("Wearables_StepsImportance")
display(mods_wearStepsImp, title="Wearables Steps Importance")
Wearables Steps Importance
Name BF LR p (LR) R2 BIC
m_mint 0.15 1501.87
m_metamint > 1000 2.28 0.011 0.10 1476.89
m_minimint > 1000 2.49 0.006 0.09 1481.29
m_micromint 521.34 2.85 0.002 0.07 1489.35
m_maia 0.601 1.33 0.091 0.11 1502.88
m_imaia > 1000 1.68 0.047 0.09 1478.59
m_ias > 1000 3.07 0.001 0.05 1485.31
m_bpq 19.31 3.71 < .001 0.02 1495.95

Each model is compared to m_mint.

Code
df$Wearables_WeightOwn <- ifelse(df$Wearables_Weight == "Not owning", 0, 1)
preds_wearWeightOwn <- compare_predictors("Wearables_WeightOwn")
display(preds_wearWeightOwn$table, title="Wearables Weight Ownership")
Wearables Weight Ownership
Name BF LR p (LR) R2 BIC Coefficient
MINT_SexS 0.02 988.73 0.27
MAIA_NotWorrying 0.011 1.18 0.120 0.00 997.67 0.12
BPQ 0.003 1.68 0.047 0.00 1000.20 0.03
IAS 0.003 1.71 0.044 0.00 1000.26 0.02

Each model is compared to MINT_SexS.

Code
preds_wearWeightOwn$p

Code
mods_wearWeightOwn <- compare_models_glm("Wearables_WeightOwn")
display(mods_wearWeightOwn$table, title="Wearables Weight Ownership")
Wearables Weight Ownership
Name BF LR p (LR) R2 BIC
m_mint 0.04 1034.90
m_metamint > 1000 2.66 0.004 0.00 1010.43
m_minimint > 1000 2.80 0.003 0.00 1013.45
m_micromint > 1000 2.61 0.005 0.01 1009.67
m_maia 0.178 1.87 0.031 0.01 1038.35
m_imaia > 1000 2.40 0.008 0.01 1009.74
m_ias > 1000 2.82 0.002 0.00 1000.26
m_bpq > 1000 2.80 0.003 0.00 1000.20

Each model is compared to m_mint.

Code
preds_wearWeightImp <- compare_predictors("Wearables_WeightImportance")
display(preds_wearWeightImp$table, title="Wearables Weight Importance")
Wearables Weight Importance
Name BF LR p (LR) R2 BIC Coefficient
MINT_Awareness 0.02 1076.27 0.27
MAIA_Noticing 12.79 -0.71 0.239 0.04 1071.17 0.29
BPQ 0.066 1.09 0.138 0.00 1081.69 0.05
IAS 12.84 -0.92 0.180 0.04 1071.16 0.03

Each model is compared to MINT_Awareness.

Code
preds_wearWeightImp$p

Code
mods_wearWeightImp <- compare_models_lm("Wearables_WeightImportance")
display(mods_wearWeightImp, title="Wearables Weight Importance")
Wearables Weight Importance
Name BF LR p (LR) R2 BIC
m_mint 0.06 1120.93
m_metamint > 1000 1.45 0.073 0.03 1083.56
m_minimint > 1000 1.28 0.100 0.04 1082.22
m_micromint > 1000 1.61 0.053 0.03 1084.71
m_maia > 1000 -0.38 0.350 0.07 1100.16
m_imaia > 1000 0.52 0.301 0.04 1080.23
m_ias > 1000 0.80 0.213 0.04 1071.16
m_bpq > 1000 2.16 0.015 0.00 1081.69

Each model is compared to m_mint.

Summary Table

Code
make_table1 <- function(preds=preds_dif, mods=mods_dif, group = "Alexithymia", outcome = "TAS - DIF") {
  yvar <- preds$outcome
  preds <- preds$table
  
  best_pred_mint <- preds[str_detect(preds$Name, "MINT"), ]
  best_pred_nonmint <- preds[!str_detect(preds$Name, "MINT"), ]
  best_pred_nonmint <- best_pred_nonmint[best_pred_nonmint$R2 == max(best_pred_nonmint$R2), ][1,]
  best_models_R2 <- str_remove(arrange(mods, desc(as.numeric(R2)))$Name, "m_")
  best_model_BIC <- str_remove(arrange(mods, as.numeric(BIC))$Name, "m_")
  
  if(length(unique(df[[yvar]])) > 2) {
    # LMs - display correlation
    r_mint <- cor.test(cbind(df, metamint)[[best_pred_mint$Name[1]]], df[[yvar]])
    r_mint <- paste0(insight::format_value(r_mint$estimate, zap_small = TRUE))
    r_nonmint <- cor.test(df[[best_pred_nonmint$Name[1]]], df[[yvar]])
    r_nonmint <- paste0(insight::format_value(r_nonmint$estimate, zap_small = TRUE))
  } else {
    # GLMs - display log-odds
    r_mint <- best_pred_mint$Coefficient
    r_nonmint <- best_pred_nonmint$Coefficient
  }
  
  # Format
  best_models_R2[str_detect(best_models_R2, "mint")] <- paste0("<b>", best_models_R2[str_detect(best_models_R2, "mint")], "</b>")
  best_model_BIC[str_detect(best_model_BIC, "mint")] <- paste0("<b>", best_model_BIC[str_detect(best_model_BIC, "mint")], "</b>")
  best_models_R2 <- paste0("<small>", paste0(best_models_R2, collapse = " > "), "</small>")
  best_model_BIC <- paste0("<small>", paste0(best_model_BIC, collapse = " > "), "</small>")
  
  
  data.frame(
    Group = group,
    Outcome = outcome, 
    Best_MINT_Predictor = paste0(str_remove(best_pred_mint$Name[1], "MINT_"), "<br><small><i>(", r_mint, ")</i></small>"),
    Best_NonMINT_Predictor = paste0(str_replace(best_pred_nonmint$Name[1], "_", " - "), "<br><small><i>(",  r_nonmint, ")</i></small>"),
    Best_Models_R2 = best_models_R2,
    Best_Models_BIC = best_model_BIC
    )
}

rez <- rbind(
  make_table1(preds_dif, mods_dif, group = "Alexithymia", outcome = "Difficulty Identifying Feelings (DIF)<small><p align='right'><i>TAS-20</i></small><p>"),
  make_table1(preds_ddf, mods_ddf, group = "Alexithymia", outcome = "Difficulty Describing Feelings (DDF)<small><p align='right'><i>TAS-20</i></small><p>"),
  make_table1(preds_eot, mods_eot, group = "Alexithymia", outcome = "Externally Oriented Thinking (EOT)<small><p align='right'><i>TAS-20</i></small><p>"),
  
  make_table1(preds_arou, mods_arou, group = "Emotion Reactivity", outcome = "Arousal<small><p align='right'><i>ERS</i></small><p>"),
  make_table1(preds_sens, mods_sens, group = "Emotion Reactivity", outcome = "Sensitivity<small><p align='right'><i>ERS</i></small><p>"),
  make_table1(preds_pers, mods_pers, group = "Emotion Reactivity", outcome = "Persistence<small><p align='right'><i>ERS</i></small><p>"),
  
  make_table1(preds_ls, mods_ls, group = "Mood", outcome = "Life Satisfaction"),
  make_table1(preds_anx, mods_anx, group = "Mood", outcome = "Anxiety<small><p align='right'><i>PHQ-4</i></small><p>"),
  make_table1(preds_dep, mods_dep, group = "Mood", outcome = "Depression<small><p align='right'><i>PHQ-4</i></small><p>"),
  
  make_table1(preds_moodt, mods_moodt$table, group = "Mental Health", outcome = "Mood Disorder"),
  make_table1(preds_adhd, mods_adhd$table, group = "Mental Health", outcome = "ADHD"),
  make_table1(preds_asd, mods_asd$table, group = "Mental Health", outcome = "Autism"),
  
  make_table1(preds_afferent, mods_afferent$table, group = "Somatic Health", outcome = "Afferent Sensitivity<small><small><p align='right'><i>Migraine, neuropathy, muscle tension, dizziness, ...</i></small></small><p>"),
  make_table1(preds_central, mods_central$table, group = "Somatic Health", outcome = "Central Sensitization<small><small><p align='right'><i>Fibromyalgia, chronic fatigue, back pain, IBS, ...</i></small></small><p>"),
  make_table1(preds_autonomic, mods_autonomic$table, group = "Somatic Health", outcome = "Autonomic Dysfunction<small><small><p align='right'><i>Hypermobility, chest pain, hypo/hypertension, ...</i></small></small><p>"),
  make_table1(preds_immune, mods_immune$table, group = "Somatic Health", outcome = "Immune-Inflammatory<small><small><p align='right'><i>Allergies, eczema, autoimmune, ...</i></small></small><p>"),
  
  make_table1(preds_cefsabody, mods_cefsabody, group = "Dissociative Symptoms", outcome = "Body<small><p align='right'><i>CEFSA</i></small><p>"),
  make_table1(preds_cefsaself, mods_cefsaself, group = "Dissociative Symptoms", outcome = "Self<small><p align='right'><i>CEFSA</i></small><p>"),
  make_table1(preds_cefsaemo, mods_cefsaemo, group = "Dissociative Symptoms", outcome = "Emotions<small><p align='right'><i>CEFSA</i></small><p>"),
  make_table1(preds_cefsareal, mods_cefsareal, group = "Dissociative Symptoms", outcome = "Reality<small><p align='right'><i>CEFSA</i></small><p>"),
  
  # make_table1(preds_pialive, mods_pialive, group = "Primals", outcome = "Alive<small><p align='right'><i>PI-18</i></small><p>"),
  # make_table1(preds_pisafe, mods_pisafe, group = "Primals", outcome = "Safe<small><p align='right'><i>PI-18</i></small><p>"),
  # make_table1(preds_pient, mods_pient, group = "Primals", outcome = "Enticing<small><p align='right'><i>PI-18</i></small><p>"),
  # make_table1(preds_pigood, mods_pigood, group = "Primals", outcome = "Good<small><p align='right'><i>PI-18</i></small><p>")
  
  make_table1(preds_bmi, mods_bmi, group = "Lifestyle", outcome = "BMI"),
  make_table1(preds_physactiv, mods_physactiv, group = "Lifestyle", outcome = "Physical Activity"),
  # make_table1(preds_age, mods_age, group = "Lifestyle", outcome = "Age"),
  make_table1(preds_wearHeartImp, mods_wearHeartImp, group = "Lifestyle", outcome = "Cardiac Monitoring"),
  make_table1(preds_wearSleepImp, mods_wearSleepImp, group = "Lifestyle", outcome = "Sleep Monitoring"),
  make_table1(preds_wearStepsImp, mods_wearStepsImp, group = "Lifestyle", outcome = "Steps Monitoring")
  # make_table1(preds_wearWeightImp, mods_wearWeightImp, group = "Lifestyle", outcome = "Weight Monitoring")
)

tab2 <- rez |> 
  gt::gt() |> 
  gt::tab_header(
    title = gt::md("**Interoceptive Questionnaires Comparison**"),
    subtitle = "MINT vs. MAIA, IAS, BPQ"
  ) |> 
  gt::cols_width(
    Outcome ~ gt::pct(23),
    Best_MINT_Predictor ~ gt::pct(12),
    Best_NonMINT_Predictor ~ gt::pct(15),
    Best_Models_R2 ~ gt::pct(25),
    Best_Models_BIC ~ gt::pct(25)
  ) |> 
  gt::tab_style(
    style = gt::cell_text(weight="bold", v_align = "middle"),
    locations = gt::cells_column_labels()
  )  |>
  gt::tab_style(
    style = gt::cell_text(align = "center", v_align = "middle"),
    locations = gt::cells_body(columns=c("Best_MINT_Predictor", "Best_NonMINT_Predictor"))
  )  |>
  gt::tab_row_group(
    label = "Lifestyle",
    rows = Group == "Lifestyle"
  ) |> 
  gt::tab_row_group(
    label = "Dissociative Symptoms",
    rows = Group == "Dissociative Symptoms"
  ) |> 
  gt::tab_row_group(
    label = "Primal World Beliefs",
    rows = Group == "Primals"
  ) |> 
  gt::tab_row_group(
    label = "Somatic Health",
    rows = Group == "Somatic Health"
  ) |> 
  gt::tab_row_group(
    label = "Mental Health",
    rows = Group == "Mental Health"
  ) |>
  gt::tab_row_group(
    label = "Mood",
    rows = Group == "Mood"
  ) |> 
  gt::tab_row_group(
    label = "Emotional Reactivity",
    rows = Group == "Emotion Reactivity"
  ) |> 
  gt::tab_row_group(
    label = "Alexithymia",
    rows = Group == "Alexithymia"
  ) |> 
  gt::tab_style(
    style = list(
      gt::cell_fill(color = "gray85"),
      gt::cell_text(weight="bold", style="italic")),
    locations = gt::cells_row_groups()
  )  |> 
  gt::tab_style(
    style = gt::cell_fill(color = "#81C784"),
    locations = list(
      gt::cells_body(columns="Best_MINT_Predictor", rows=c(1:4, 11:18, 20:21, 24))
    )
  ) |> 
  gt::tab_style(
    style = gt::cell_fill(color = "#FFB74D"),
    locations = list(
      gt::cells_body(columns="Best_MINT_Predictor", rows=c(5:9, 10, 19, 22))
    )
  ) |> 
  gt::tab_style(
    style = gt::cell_fill(color = "#EF9A9A"),
    locations = list(
      gt::cells_body(columns="Best_MINT_Predictor", rows=c(23, 25))
    )
  ) |> 
  gt::tab_style(
    style = gt::cell_fill(color = "#81C784"),
    locations = list(
      gt::cells_body(columns="Best_Models_R2", rows=c(1:3, 11:13, 15:21, 23:25))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#FFB74D"),
    locations = list(
      gt::cells_body(columns="Best_Models_R2", rows=c(4:10, 14, 22))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#81C784"),
    locations = list(
      gt::cells_body(columns="Best_Models_BIC", rows=c(1:3, 11:20, 25))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#FFB74D"),
    locations = list(
      gt::cells_body(columns="Best_Models_BIC", rows=c(4:10, 22))
    )
  ) |>
  gt::tab_style(
    style = gt::cell_fill(color = "#EF9A9A"),
    locations = list(
      gt::cells_body(columns="Best_Models_BIC", rows=c(21, 23, 24))
    )
  ) |>
  gt::cols_label(
    Best_MINT_Predictor = "Best Predictor\n(MINT)",
    Best_NonMINT_Predictor = "Best Predictor\n(Non-MINT)",
    Best_Models_R2 = "Best Models (R2)",
    Best_Models_BIC = "Best Models (BIC)"
  ) |> 
  gt::cols_hide(Group) |> 
  gt::fmt_markdown() |> 
  gt::tab_options(
    table.font.size = gt::pct(125)
  )


tab2 |> 
  gt::tab_options(
    table.font.size = gt::pct(50)
  ) |> 
  gt::opt_interactive()
Interoceptive Questionnaires Comparison
MINT vs. MAIA, IAS, BPQ
Code
gt::gtsave(tab2, "figures/table2.png", vwidth=1400, expand=0, quiet=TRUE)

Figures

Code
fig1a <- patchwork::wrap_elements(
  patchwork::wrap_elements(grid::rasterGrob(png::readPNG("figures/fig1a.png"))) +
  patchwork::plot_annotation(title = "Exploratory Graphical Analysis (EGA)",
                             subtitle = "Bootstrapped replication of hierarchical clusters (Methhod = leiden)",
                             theme = theme(plot.title = element_text(face="bold", hjust = 0, size = rel(1.4)),
                                           plot.subtitle = element_text(hjust = 0, size = rel(1)))))
fig1b <- patchwork::wrap_elements(
  patchwork::wrap_elements(grid::rasterGrob(png::readPNG("figures/fig1b.png"))) +
  patchwork::plot_annotation(title = "Hierarchical Clustering",
                             subtitle = "Method = Correlation",
                             theme = theme(plot.title = element_text(face="bold", hjust = 0, size = rel(1.4)),
                                           plot.subtitle = element_text(hjust = 0, size = rel(1)))))
ggsave("figures/fig1.png", fig1a / fig1b, width=8, height=12, dpi=300)




p_cor <- df |> 
  select(starts_with("TAS_"), LifeSatisfaction, starts_with("PHQ4_"), starts_with("CEFSA"), starts_with("PI"), starts_with("ERS_")) |> 
  mutate(LifeSatisfaction = datawizard::reverse_scale(LifeSatisfaction),
         PI_Safe = datawizard::reverse_scale(PI_Safe),
         PI_Good = datawizard::reverse_scale(PI_Good),
         PI_Enticing = datawizard::reverse_scale(PI_Enticing)) |>
  rename(`Life Satisfaction*` = LifeSatisfaction,
         `Primals - Alive` = PI_Alive,
         `Primals - Safe*` = PI_Safe,
         `Primals - Good*` = PI_Good,
         `Primals - Enticing*` = PI_Enticing) |>
  make_cor(cbind(mint, metamint, select(df, starts_with("MAIA"), IAS, BPQ))) +
  labs(title="Correlates of Interoception") 
p_cor

fig2 <- (p_cormint | p_corintero) / p_cor + plot_layout(heights = c(0.4, 0.6))
ggsave("figures/fig2.png", fig2, width=10, height=12, dpi=300)





fig3 <- (mods_moodt$p + theme(axis.text.x = element_blank(), axis.title.x = element_blank()) | 
    mods_adhd$p + theme(axis.text.x = element_blank(), axis.title.x = element_blank()) | 
    mods_asd$p + theme(axis.text.x = element_blank(), axis.title.x = element_blank())) / 
  (mods_central$p | mods_autonomic$p | mods_immune$p) +
  plot_layout(guides = "collect") +
  plot_annotation(title = "Predictive Performance of Interoceptive Questionnaires", 
       subtitle = "ROC Curves",
       theme = theme(plot.title = element_text(face="bold", hjust = 0.5, size = rel(1.4)),
                     plot.subtitle = element_text(hjust = 0.5, size = rel(1.25))))
fig3
ggsave("figures/fig3.png", fig3, width=13, height=9, dpi=300)